Skip to content

Instantly share code, notes, and snippets.

View jhthorsen's full-sized avatar

Jan Henning Thorsen jhthorsen

133 followers · 13 following
View GitHub Profile
@jhthorsen
jhthorsen / without_header.pl
Created June 25, 2014 09:21
How to make a response without headers, http://www.w3.org/Protocols/rfc2616/rfc2616-sec6.html#sec6
#!/usr/bin/env perl
package No::Headers;
use Mojo::Base "Mojo::Headers";
sub to_string { "" };
package main;
use Mojolicious::Lite;
get "/" => sub {
my $c = shift;
@jhthorsen
jhthorsen / mojo.log
Created July 24, 2014 12:44
make a new mojolicious dist #mojo
git remote update
git rebase origin/master
# no diff
git tag v5.17
perl Makefile.PL; make manifest; make dist
1) make sure master is in a good state
2) tag release
3) perl Makefile.PL; make manifest; make dist
4) upload release, ...optional...
@jhthorsen
jhthorsen / oauth2.pl
Created November 2, 2014 15:37
plugin 'OAuth2', {
google => {
key => 'public app id from google',
secret => 'private secret from google',
},
};
@jhthorsen
jhthorsen / getpeereid.pl
Created November 7, 2014 08:57
This example show how to get the peer username from a unix socket. (getpeereid SO_PEERCRED AF_UNIX)
# See also
# http://www.perlmonks.org/bare/?node_id=881003
# http://www.freebsd.org/cgi/man.cgi?query=getpeereid
use strict;
use warnings;
use IO::Socket::UNIX;
use Socket qw( SO_PEERCRED SOL_SOCKET );
if (@ARGV) {
IO::Socket::UNIX->new(Peer => $ARGV[0], Type => SOCK_STREAM, Timeout => 10) or die $@;
@jhthorsen
jhthorsen / Mojo-IOLoop-Tail.pm
Created January 8, 2015 11:00
package Mojo::IOLoop::Tail;
use Mojo::Base "Mojo::IOLoop::Stream";
has check_timeout => 0.01;
sub close {
my $self = shift;
return unless my $handle = $self->{handle};
seek $handle, 0, 1;
@jhthorsen
jhthorsen / stdinping.pl
Created February 20, 2015 11:05
This program can read a list of IP's from STDIN and ping them non-blocking
#!/usr/bin/perl
# Usage: echo -en "1.1.0.1\n127.0.0.1\n" | sudo /usr/bin/perl stdinping
# A lot of this code is mostly copy/paste/modify from Net::Ping
BEGIN {
# Make sure we don't load code that is not owned by root
$^X eq "/usr/bin/perl" or die "Invalid perl: $^X\n";
my @perl_stat = stat $^X;
unshift @INC, sub {
my ($code, $module) = @_;
@jhthorsen
jhthorsen / SugarTree.pm
Created September 21, 2011 16:53
Example of how to export sugar
package SugarTree;
=head1 NAME
SugarTree - Create datastructures with sugar
=head1 SYNOPSIS
use SugarTree;
@jhthorsen
jhthorsen / goto_RETURN.pl
Created December 1, 2011 08:50
return from inside sub{}
#!/usr/bin/env perl
use strict;
use warnings;
sub foo {
my $res = '';
warn "foo(): @_";
(sub {
@jhthorsen
jhthorsen / autoinstalldeps.pm
Created February 16, 2012 23:51
A pice of code which automatically will install perl dependencies
use IO::Socket::INET; use File::Basename; use File::Path; BEGIN {
our $SOURCE = $ENV{'AUTO_INSTALL_DEPS_SOURCE'} || 'http://api.metacpan.org:80/source/%s';
our $LIB = "$ENV{'HOME'}/.perl5";
push @INC, $LIB, sub {
my($module) = $_[1] =~ /(.*)\.pm$/; $module =~ s!/!::!g;
my($hostname) = $SOURCE =~ m!//([^/]+)!;
my $s = IO::Socket::INET->new(PeerAddr => $hostname) or die "Cannot download required library from $hostname: $@";
File::Path::make_path(dirname "$LIB/$_[1]");
open my $FH, '+>', "$LIB/$_[1]" or die "Write $LIB/$_[1]: $!";
printf STDERR "GET $SOURCE HTTP/1.1\n", $module if $ENV{'AUTO_INSTALL_DEPS_DEBUG'};
@jhthorsen
jhthorsen / post-receive
Created March 13, 2012 20:55
post-receive hook for git
#!/bin/sh
BACKUP=$GIT_DIR; # need to be first?
GIT_DIR="path/to/my/repo/.git";
while read oldrev newrev refname; do
BRANCH=$(echo $refname | cut -f3 -d/);
echo branch $BRANCH
if [ "x$BRANCH" = "xalien" ]; then
cd $GIT_DIR;