perls

check_lib.pl

#!/usr/bin/env perl
# cklib
# checks if lib is in $path /$ARGV[0]/
use 5.010;

use FFI::CheckLib;
 check_lib_or_exit( lib => 'jpeg', symbol => 'jinit_memory_mgr' );
 check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] );
 # or prompt for path to library and then: print "where to find jpeg library: ";
 my $path = <STDIN>;
 check_lib_or_exit( lib => 'jpeg', libpath => $path );
CheckLiblib.dll.so*[]use FFI::CheckLib;
 use FFI::Platypus;
 my($lib) = find_lib( name => 'foo', verify => sub { my($name, $libpath) = @_;
 my $ffi = FFI::Platypus->new;
 $ffi->lib($libpath);
 my $f = $ffi->function('foo_version', [] => 'int');
 return $f->call() >= 500;
 # we accept version 500 or better }, );
libpathMakefile.PLBuild.PL

cklib

#!/usr/bin/env perl

# checks for shared lib
# ex.check libssh; defaults to /usr/lib
#   cklib ssh
# ex.check libssh in elsewhere;
#   cklib ssh $THEOS/sdks


use 5.010;
use warnings;
use strict;

use FFI::CheckLib;
my( $lib, $path ) = @ARGV;

my $libs = sub {
    my( $lib, $path ) = shift;
    my( @libs ) = ();
    @libs = find_lib( lib => "$lib", libpath => $path );
    return \@libs;
};


$path  = /usr/lib unless $ARGV[1];

for ( @{$libs->( $lib, $path )} ){
    say $_;
}

daemon.pl

#!/usr/bin/env perl
# source perlmonks.org
# simple p5 script will daemonize itself after start w/o nohup or any ext modules;
# output redirected to /tmp/out instead of terminal STDOUT
# Usefull links:
# perlopentricks by BDFOY - http://perltricks.com/article/182/2015/7/15/Stupid-open---tricks
# 'perldoc perlopentut' - intro to open function 
# 'perldoc -f open' - comprehensive open teference

sub daemonize {
    chdir '/'               or die "Can't chdir to /: $!";
    open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
    open STDOUT, '>>/tmp/out' or die "Can't write to /dev/null: $!";
   
    defined(my $pid = fork) or die "Can't fork: $!";
    exit if $pid;
    setsid                  or die "Can't start a new session: $!";
    open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}

print "Now backgrounding your process..\n";
daemonize();

# your cone goes here 
while( 1 ){
    print 'printing into default'.`date`;
    sleep 5;
}

get-perls2mem.pl

# get all .pl from scripts/arm folder into hash

perl -MIO::All -MData::Dumper -MJSON -E '$io = io("scripts/arm");
 @fl = $io->all;
 for( @fl ){
    my $f < io($_); $pl{$_} = $f if /\.pl/;
};
print Dumper(\%pl);
'

githubs-from-drafts-urls.sh

#!/usr/bin/env perl
# get Title from github URLs in iOS Draft notes

use 5.010;

my $draft=q!sqlite3 $ENV{DRAFT}/Documents/Drafts.sqlite 'select * from ZDRAFT'!
open(NET, "$draft |");

while( <NET> ){
    if ( /https\:\/\/github\.com/ ) { 
        s/(https\:\/\/|git)(github\.com\/.*?\/)(.*?)(\/|\ |\.git|\.md).*/$1$2$3$4/g; 
        push @gits, $3; 
    };
}
close(NET);
say "@gits";

load_json.pl

#!/usr/bin/env perl

# Got used to IO::All but in case i want to do stuff with less dependencies i use this clean way to load default
# json config (array of objects) from __DATA__ at the end which is turned into array of hashes unless there is
# an -f argument with /path/to/other.json In that case json will be read from that path. z448
# from v2.0 having 'use JSON;' will use JSON::XS if available, otherwise will fallback to JSON::PP,
# a core perl module since p5.13.9 (corelist -a JSON::PP). It's pure perl therefore its possible to pack
# it along with script (App::FatPacker) and use it with older perl (< 5.13.9)

use JSON;       #  -------both core perl modules (>5.13.9)
use HTTP::Tiny; #
use Getopt::Std;
use open qw< :encoding(UTF-8) >;
use Data::Dumper;

my $fh = undef;
getopts('f:', \%opts);

my $http_req = sub {
    my $http_json = HTTP::Tiny->new->get("$opts{'f'}");
    return qq|[{"reason":"$http_json->{reason}"},{"status":"$http_json->{status}"}]| unless $http_json->{success};
    return $http_json->{content};
};

sub get_conf {
    my $conf;
    local $/ = undef;

    unless($opts{'f'}){   #--- take json from -f otion and return hash of array
        $conf = <DATA>;
        close $fh;
        return decode_json $conf;

    } else {
        if( $opts{'f'} =~ /http\:\// ) {
            return decode_json &$http_req;
        } else {
            open($fh, "<", $opts{'f'})||die "$0:can't open file $!";
            $conf = <$fh>;
            close $fh;
            return decode_json $conf;
        }
    }
}


my $conf = get_conf();
print $conf->[1]->{name};
print Dumper($conf);

# Default init data
__DATA__
[{"name":"Jon","optional":0,"address":"Elm Street","id":"448"},{"name":"Dirk","optional":0,"address":"Street","id":"16"}]

point

#!/usr/bin/env perl
use v5.10;
use warnings;
use strict;

# easy way execute sh cmd on remote host;
# usage:
# change to your user&IP current is mobile & 10.0.0.33
# point && shot
# write some cmd.. then Ctrl-D

my $shell = sub {
    my $sh = shift;

    open( my $fh, '>', "$sh->{tmp}" );

    for( @{$sh->{sh}} ){
        print $fh $_;
    }; close $fh;
#    $fh = undef;
    my $check = 'ssh '.$sh->{user}.'@'.$sh->{ip}." \'cat .log\'";
    open( $fh, '>', $sh->{shot} );
    say $fh qq|\`ssh $sh->{ip} -l $sh->{user} \$(<$sh->{tmp})\`\n$check|;
    close $fh;
};

my @shot;
while( <> ){
    push @shot, $_ . ' >> .log'."\n";
}

my $shot = {
    tmp     =>  '._',
    sh    =>  \@shot,
    ip     =>  '10.0.0.33',
    user    =>  'mobile',
    shot    =>  'shot'
};

$shell->( $shot );

#perl -e 'chomp(my $date=qx!date!); print qq!hello_perl\t $date\n!;' >> sh.log;
#echo -e "hello_sh\t$(date)" >> sh.log

terminal-width.pl

#!/usr/bin/env perl
# returns current terminal width so you can do prety printing on output


#########################################################################
## use it from another script
#########################################################################
## #!/usr/bin/env perl
##
## require "terminal.pl";
## my $w = get_term(width); #---$m has int of terminal width
## 
## print ("-"x$w); #---print horizontal line across wholee terminal
#########################################################################

sub get_term {
    $dim = shift;
        if ($dim eq 'width' ) {  
        unless( chomp(my $stty = qx!which stty!) ) { # --------------------check terminal width so we can print pretty
            return 80;  # -------------------------------------------------set default terminal size
        }
        else {    # -------------------------------------------------------parse stty output and set real terminal width
            my @x = qx!stty -a!;
            my @y = split(/;/,$x[0]);
            my @w = split(/columns/,$y[2]);
            $w[1] =~ s/^\s+|\s+$//g;
            return $w[1];
        }
    }
}
1;