Skip to content

Instantly share code, notes, and snippets.

@z448
Last active May 6, 2019 15:45
Show Gist options
  • Save z448/d69150eae0ba8cd3d6a0 to your computer and use it in GitHub Desktop.
Save z448/d69150eae0ba8cd3d6a0 to your computer and use it in GitHub Desktop.
perls
#!/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
#!/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 $_;
}
#!/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 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);
'
#!/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";
#!/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"}]
#!/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
#!/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;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment