Acme-Schlong

 view release on metacpan or  search on metacpan

lib/Acme/Schlong.pm  view on Meta::CPAN

    # 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 }
    method _build_perl_version           { $_ = `$^X --version`; m/perl.*\((?<vstring>v\d\.\d+.\d+)\) built for.*/; $+{vstring} }
    # method _build_perl_version_is_dev    { version->new($self->perl_version)->version->[1] % 2 ? 1 : 0 } # is_alpha
    method _build_directories_in_path    { scalar split q<:> =>      $ENV{PATH}         }

t/00-report-prereqs.t  view on Meta::CPAN

my @reports = [qw/Version Module/];

for my $mod ( @modules ) {
  next if $mod eq 'perl';
  my $file = $mod;
  $file =~ s{::}{/}g;
  $file .= ".pm";
  my ($prefix) = grep { -e catfile($_, $file) } @INC;
  if ( $prefix ) {
    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;

t/000-report-versions.t  view on Meta::CPAN

sub read {
    my $class = ref $_[0] ? ref shift : shift;

    # Check the file
    my $file = shift or return $class->_error( 'You did not specify a file name' );
    return $class->_error( "File '$file' does not exist" )              unless -e $file;
    return $class->_error( "'$file' is a directory, not a file" )       unless -f _;
    return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;

    # Slurp in the file
    local $/ = undef;
    local *CFG;
    unless ( open(CFG, $file) ) {
        return $class->_error("Failed to open file '$file': $!");
    }
    my $contents = <CFG>;
    unless ( close(CFG) ) {
        return $class->_error("Failed to close file '$file': $!");
    }

    $class->read_string( $contents );

t/000-report-versions.t  view on Meta::CPAN

    # Strip the initial YAML header
    @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;

    # A nibbling parser
    while ( @lines ) {
        # Do we have a document header?
        if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
            # Handle scalar documents
            shift @lines;
            if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
                push @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
                next;
            }
        }

        if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
            # A naked document
            push @$self, undef;
            while ( @lines and $lines[0] !~ /^---/ ) {
                shift @lines;
            }

        } elsif ( $lines[0] =~ /^\s*\-/ ) {
            # An array at the root
            my $document = [ ];
            push @$self, $document;
            $self->_read_array( $document, [ 0 ], \@lines );

t/000-report-versions.t  view on Meta::CPAN

    $self;
}

# Deparse a scalar string to the actual scalar
sub _read_scalar {
    my ($self, $string, $indent, $lines) = @_;

    # Trim trailing whitespace
    $string =~ s/\s*\z//;

    # Explitic null/undef
    return undef if $string eq '~';

    # Quotes
    if ( $string =~ /^\'(.*?)\'\z/ ) {
        return '' unless defined $1;
        $string = $1;
        $string =~ s/\'\'/\'/g;
        return $string;
    }
    if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
        # Reusing the variable is a little ugly,

t/000-report-versions.t  view on Meta::CPAN

        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 );

t/000-report-versions.t  view on Meta::CPAN

            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 {
    $YAML::Tiny::errstr = $_[1];
    undef;
}

# Retrieve error
sub errstr {
    $YAML::Tiny::errstr;
}



#####################################################################
# Use Scalar::Util if possible, otherwise emulate it

BEGIN {
    eval {
        require Scalar::Util;
    };
    if ( $@ ) {
        # Failed to load Scalar::Util
        eval <<'END_PERL';
sub refaddr {
    my $pkg = ref($_[0]) or return undef;
    if (!!UNIVERSAL::can($_[0], 'can')) {
        bless $_[0], 'Scalar::Util::Fake';
    } else {
        $pkg = undef;
    }
    "$_[0]" =~ /0x(\w+)/;
    my $i = do { local $^W; hex $1 };
    bless $_[0], $pkg if defined $pkg;
    $i;
}
END_PERL
    } else {
        Scalar::Util->import('refaddr');
    }

t/000-report-versions.t  view on Meta::CPAN

    diag("Testing with Perl $], $^X");
    for my $module (sort keys %requires) {
        if ($skip{$module}) {
            note "$module doesn't want to be loaded directly, skipping";
            next;
        }
        local $SIG{__WARN__} = sub { note "$module: $_[0]" };
        require_ok $module or BAIL_OUT("can't load $module");
        my $version = $module->VERSION;
        $version = 'undefined' unless defined $version;
        diag("    $module version is $version");
    }
    done_testing;
}