Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

strip extension

  • Loading branch information...
commit 34abc837aad3250137ccb8772230a4a3f7ee895b 1 parent 844ee65
japh woldrich authored
Showing with 4,456 additions and 55 deletions.
  1. 0  .gitignore
  2. +2 −0  1984
  3. +83 −0 List::MoreUtils
  4. 0  anagrams
  5. +87 −0 authors
  6. +12 −0 battery_prompt
  7. +12 −0 bigrand
  8. +39 −0 by_extension
  9. +54 −0 clftail
  10. +49 −0 colorls
  11. +31 −0 colorscheme
  12. +43 −0 convert
  13. +14 −0 cpmpd
  14. +36 −0 cpnewfavs
  15. +68 −0 crossmake
  16. +13 −55 ddg
  17. +29 −0 deparse
  18. +62 −0 digits
  19. +91 −0 div_rule
  20. 0  dmenushit
  21. +51 −0 dmesg
  22. +102 −0 filebytype
  23. 0  filetypes
  24. +20 −0 fimpc
  25. +63 −0 fullwidth
  26. +125 −0 generate_xresources
  27. +131 −0 git-rec
  28. +10 −0 google_dmenu
  29. +212 −0 google_tlds
  30. +11 −0 grmpd
  31. +65 −0 httpdhits
  32. +88 −0 imv
  33. +75 −0 iterate
  34. +1 −0  japh1277971998
  35. +40 −0 laleh-check
  36. 0  lib/Net::Google::TLD/blib/arch/.exists
  37. 0  lib/Net::Google::TLD/blib/arch/auto/Net/Google/TLD/.exists
  38. 0  lib/Net::Google::TLD/blib/bin/.exists
  39. 0  lib/Net::Google::TLD/blib/lib/Net/Google/.exists
  40. +634 −0 lib/Net::Google::TLD/blib/lib/Net/Google/TLD.pm
  41. 0  lib/Net::Google::TLD/blib/lib/auto/Net/Google/TLD/.exists
  42. 0  lib/Net::Google::TLD/blib/man1/.exists
  43. 0  lib/Net::Google::TLD/blib/man3/.exists
  44. +165 −0 lib/Net::Google::TLD/blib/man3/Net::Google::TLD.3pm
  45. 0  lib/Net::Google::TLD/blib/script/.exists
  46. 0  lib/Net::Google::TLD/pm_to_blib
  47. +4 −0 ls2
  48. +113 −0 lscolorpicker
  49. 0  lscolorpicker.sh
  50. +44 −0 mailme
  51. +39 −0 makedist
  52. +23 −0 merlyn-columns
  53. +52 −0 mount-shiva
  54. +11 −0 mountlast
  55. +191 −0 mpd_relevancy
  56. 0  mpdcp.rc
  57. +25 −0 mpdstats
  58. +1 −0  nicefind
  59. +19 −0 pacstat
  60. +16 −0 parselscolors
  61. +45 −0 pdf
  62. +28 −0 pimpla
  63. +13 −0 pmdesc
  64. +62 −0 punctation
  65. +7 −0 pushall
  66. +66 −0 pwc
  67. +11 −0 randwall
  68. +145 −0 rel
  69. +22 −0 rensafilm
  70. +26 −0 rensamusik
  71. +2 −0  rescue_chmod
  72. +59 −0 rgb_by_index
  73. +13 −0 rgbtohex
  74. +66 −0 rgbxterm
  75. +13 −0 sascii
  76. +21 −0 scpan
  77. +39 −0 sidtop
  78. +28 −0 simart
  79. +18 −0 sort_aliases
  80. 0  strip_esc
  81. +7 −0 stumpdump
  82. +69 −0 svtplay
  83. +135 −0 uncode
  84. +3 −0  ungzip
  85. +54 −0 vimcolors
  86. +31 −0 vimsyntax
  87. +2 −0  we
  88. +2 −0  wf
  89. +78 −0 whitespace
  90. +10 −0 wtc
  91. +32 −0 xbmc-tv
  92. +43 −0 xmk
  93. +61 −0 xtermcolchange
  94. +189 −0 youtube_parallelfetch
0  .gitignore 100644 → 100755
View
File mode changed
2  1984
View
@@ -0,0 +1,2 @@
+foo=$(uptime|perl -pe 's/.+up (.+)/$1/')
+echo -e "$(date)\b\b\b\b\b\b\t1984: $foo"|pv -L 10 -q
83 List::MoreUtils
View
@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+# All functions from the List::MoreUtils module ported using map
+use strict;
+use List::Util 'shuffle';
+
+$\ = "\n";
+my @foo = map{ sprintf("%03d", $_) } (0..200);
+
+
+{
+ # List::MoreUtils::all
+ my $i = 0;
+ map { /\d+/ and $i++; } @foo;
+ print 'all: yes' if($i == scalar(@foo));
+}
+
+
+# List::MoreUtils::none
+print 'none: no' if ! map {my $i = 0; /\d{4}/ and $i++; $i } @foo;
+
+
+
+# List::MoreUtils::any
+print 'any: yes' if map { my $i = 0; /^19\d/ and $i++; $i } @foo;
+
+
+{
+ # List::MoreUtils::true
+ my $i = 0;
+ print "true: $i" if map { $_ and $i++; } @foo;
+}
+
+{
+ # List::MoreUtils::false
+ push(@foo, (0) x sprintf("%.d", rand(128)));
+ my $i = 0;
+ print "false: $i" if map { !$_ and $i++; } @foo;
+}
+
+{
+ # List::MoreUtils::lastidx
+ sub lastidx {
+ my %map;
+ my $i;
+ for(shuffle(@_)) {
+ if(/^1(?:3|9)/) {
+ $map{$i} = $_;
+ }
+ $i++;
+ }
+ for(sort { $a <=> $b } (keys(%map))) {
+ return($_);
+ }
+ }
+ print "lastidx: " . lastidx(@foo);
+}
+
+{
+ # List::MoreUtils::firstidx
+
+ sub firstidx {
+ my %map;
+ my $i;
+ for(shuffle(@_)) {
+ if(/^1(?:3|9)/) {
+ $map{$i} = $_;
+ }
+ $i++;
+ }
+ for(sort { $map{$a} <=> $map{$b} } (keys(%map))) {
+ return($_);
+ }
+ }
+ print "firstidx: " . firstidx(@foo);
+}
+
+{
+ # List::MoreUtils::insert_after
+ my $i = 0;
+ my $n = sprintf("%.d", rand(9));
+ map{ $_ =~ /$n/ and $_ .= ' foobar'; } @foo;
+ print "insert_after: $i" if map { / foobar$/ and $i++; $i; } @foo;
+}
0  anagrams 100644 → 100755
View
File mode changed
87 authors
View
@@ -0,0 +1,87 @@
+{
+ package Retriever;
+ use strict;
+ use warnings;
+ use URI;
+ use LWP::UserAgent;
+ use File::Spec::Unix;
+
+ my @times = qw(1h 6h 1d 1W 1M 1Q 1Y);
+
+ sub retrieve {
+ my $class = shift;
+ my %opts = @_;
+ $opts{lc $_} = delete $opts{$_} for keys %opts;
+ my $self = bless \%opts, $class;
+ $self->{uri} = URI->new( $self->{mirror} || 'http://cpan.hexten.net/' );
+ die "Unknown scheme\n"
+ unless $self->{uri} and $self->{uri}->scheme and
+ $self->{uri}->scheme =~ /^(http|ftp)$/i;
+ $self->{time} = '6h'
+ unless $self->{time}
+ and grep { $_ eq $self->{time} } @times;
+ $self->{uri}->path( File::Spec::Unix->catfile( $self->{uri}->path, 'authors', 'RECENT-' . $self->{time} . '.yaml' ) );
+ return $self->fetch();
+ }
+
+ sub fetch {
+ my $self = shift;
+ open my $fooh, '>', \$self->{foo} or die "$!\n";
+ my $ua = LWP::UserAgent->new();
+ $ua->get( $self->{uri}->as_string, ':content_cb' => sub { my $data = shift; print {$fooh} $data; } );
+ close $fooh;
+ return $self->{foo};
+ }
+}
+
+package main;
+
+use strict;
+use warnings;
+use YAML::Syck;
+use File::Spec;
+use CPAN::DistnameInfo;
+
+$!=1;
+
+my @times = qw(1h 6h 1d 1W 1M 1Q 1Y);
+
+my $time = shift || '1Y';
+$time = '6h' unless grep { $_ eq $time } @times;
+
+my $mirror = 'http://cpan.hexten.net/';
+my $path = 'authors';
+my %data;
+my %authors;
+my $finished;
+while( !$finished ) {
+ my $foo = shift @times;
+ $finished = 1 if $foo eq $time;
+ my $yaml = Retriever->retrieve( time => $foo, mirror => $mirror );
+ my @yaml;
+ eval { @yaml = YAML::Syck::Load( $yaml ); };
+ die unless @yaml;
+ my $record = shift @yaml;
+ die unless $record;
+ foreach my $recent ( reverse @{ $record->{recent} } ) {
+ next unless $recent->{path} =~ /\.(tar\.gz|tgz|tar\.bz2|zip)$/;
+ next unless $recent->{type} eq 'new';
+ next if $recent->{path} =~ /withoutworldwriteables/;
+ ( my $foo = $recent->{path} ) =~ s#^id/##;
+ $data{ $foo } = $recent->{epoch};
+
+ }
+}
+
+my $longest = 0;
+
+foreach my $path ( keys %data ) {
+ my $d = CPAN::DistnameInfo->new( $path );
+ my $id = $d->cpanid;
+ my $len = length( $id );
+ $longest = $len if $len > $longest;
+ $authors{ $id }++;
+}
+
+print "Number of CPAN Uploads grouped by author for the past 12 months: ( Generated ", scalar localtime, " )\n\n";
+print join(' ' x ( $longest - length($_) + 4 ), $_, $authors{$_}), "\n" for sort { $authors{$b} <=> $authors{$a} || $a cmp $b } keys %authors;
12 battery_prompt
View
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+use strict;
+
+for(`acpi`) {
+ s/Battery 0: (.).+, ([0-9]+)%.+\n/$1/;
+ if($1 eq 'D') {
+ print "◀▪$2";
+ }
+ else {
+ print "▪▶$2";
+ }
+}
12 bigrand
View
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+# bigrand
+use strict;
+
+print "num> ";
+while(my $num = <STDIN>) {
+ chomp($num);
+ $num = ord($num) unless $num =~ /^\d+$/;
+ my @rand = map { int(rand(101)) } 0 .. 20;
+ print "$_\n" for sort( grep{ $num < $_ } @rand);
+ print "num> ";
+}
39 by_extension
View
@@ -0,0 +1,39 @@
+#!/usr/bin/perl
+# Fetch filetype information based on extensions
+use strict;
+use LWP::Simple;
+use Storable;
+use Data::Dumper;
+$Data::Dumper::Terse = 1;
+$Data::Dumper::Indent = 1;
+$Data::Dumper::Useqq = 1;
+$Data::Dumper::Deparse = 1;
+$Data::Dumper::Quotekeys = 0;
+$Data::Dumper::Sortkeys = 1;
+
+my $url = 'http://www.cryer.co.uk/file-types/';
+
+$|++;
+my %extensions;
+
+if(-f './filetypes') {
+ %extensions = %{ retrieve('./filetypes') };
+}
+
+# <li><a href="bkp.htm">.bkp</a> - backup file</li>
+
+else {
+ for('a' .. 'z') {
+ my $c = get("$url/$_/index.htm");
+ for my $l(split(/<li>/, $c)) {
+ if($l =~ m/<a href=".+">[.](.+)<\/a> - (.+)<\/li>/) {
+ $extensions{$1} = $2;
+ }
+ }
+ }
+ store(\%extensions, './filetypes');
+}
+
+for my $e(sort(keys(%extensions))) {
+ printf("% 7s: %s\n", $e, $extensions{$e});
+}
54 clftail
View
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+use strict;
+use File::Tail;
+use Term::ExtendedColor qw(fg bg);
+
+my $log = shift;
+my $line = "";
+my $tail = File::Tail->new(name=>$log,
+ maxinterval=>3,
+ adjustafter=>3,
+ interval=>0,
+ tail=>100
+ );
+while(defined($line=$tail->read)) {
+ my $e = "(.+?)";
+ $line =~ /^$e $e $e \[$e:$e $e\] "$e $e $e" $e $e/;
+
+ my $ip = $1;
+ my $ref = $2;
+ my $name = $3;
+ my $date = $4;
+ my $time = $5;
+ my $gmt = $6;
+ my $request = $7;
+ my $file = $8;
+ my $ptcl = $9;
+ my $code = $10;
+ my $size = $11;
+
+ $code = fg(240, $code) if $code == 404;
+ $code = fg(155, $code) if $code == 200;
+ $code = fg(160, $code) if $code == 501;
+ $code = fg(208, $code) if $code == 301;
+ $code = fg(124, $code) if $code == 403;
+ $code = fg(113, $code) if $code == 304;
+
+ $request = fg(190, " $request") if $request eq 'GET';
+ $request = fg(196, " $request") if $request eq 'POST';
+ $request = fg(197, " $request") if $request eq 'CONNECT';
+
+ if($file =~ /\.(:?png|gif|jpg|jpeg)$/) {
+ $file = fg(167, $file);
+ }
+ elsif($file =~ /\.html$/) {
+ $file = fg(74, $file);
+ }
+ else {
+ $file = fg(222, $file);
+ }
+
+ $size = fg(160, $size) if $size > 5;
+ printf("%s %7s %s \e[38;5;215m%s\e[0m \t%-60.40s\n",
+ $code, $request, $size, $ip, $file) unless $file =~ m/.+\.(?:css|ico)$/
+}
49 colorls
View
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+use strict;
+use Data::Dumper;
+
+my $CPERM = "\033[38;5;131m";
+my $CFNO = "\033[38;5;132m";
+my $CDATE = "\033[38;5;149m";
+my $CDIM = "\033[38;5;100m";
+my $CPIPE = "\033[38;5;197m";
+
+@ARGV = './' unless @ARGV;
+
+# -halv ?
+my $ls = "ls -hAov --indicator-style=file-type --color=always --group-directories-first --time=ctime \"@ARGV\"";
+open(my $ph, "-|", $ls) or die $!;
+
+my @arr = <$ph>;
+
+my $i=-1;
+my %seen;
+for(@arr) {
+ ++$i;
+ next if(/^total/);
+ #s/->/▪▶/g;
+ m/^([drwxsT-]+)\s+([0-9]+)\s+([A-Za-z0-9]+)\s+([0-9KMGT\.]+)\s+([A-Za-z]{3})\s+([0-9]{1,3})\s+([0-9:]+)(.+)(->)?(.+)?$/;
+
+ my $perm = $1;
+ my $fno = $2;
+ my $user = $3;
+ my $size = $4;
+ my $month = $5;
+ my $dinmon = $6;
+ my $time = $7;
+ my $file = $8;
+ my $sym = $9;
+ my $sym_t = $10;
+
+ $seen{$file}++;
+ next if($seen{$file} > 1);
+ next if(!$file);
+
+
+ printf("$CPERM%s$CDIM%3d\033[0m $CDATE%2s\033[0m $CFNO%s\033[0m$CPIPE\033[0m%s\n",
+ $perm, $dinmon,$month,sprintf("%4d",$fno), $file);
+ print $sym,$sym_t;
+}
+print "\033[38;5;160m$i\033[0m Files\n";
+
+#print Dumper @arr;
31 colorscheme
View
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+# colorscheme.pl
+# The colorscheme I've been using for ~2 years
+
+use strict;
+use Term::ExtendedColor::Xresources qw(set_xterm_color);
+
+
+my %colors = (
+ 0 => '121212',
+ 8 => 'ffffff',
+ 1 => 'ff4747',
+ 9 => 'ff6767',
+ 2 => '2b4626',
+ 10 => 'b03b31',
+ 3 => 'ff8f00',
+ 11 => 'bdf13d',
+ 4 => '1165e9',
+ 12 => '5496ff',
+ 5 => 'aef7a4',
+ 13 => 'b50077',
+ 6 => 'cb1c13',
+ 14 => '6be603',
+ 7 => 'fcdeaf',
+ 15 => 'abcdef',
+);
+
+
+for my $ansi(keys(%colors)) {
+ print set_xterm_color($ansi, $colors{$ansi});
+}
43 convert
View
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+use strict;
+# convert
+use Getopt::Long;
+
+usage() unless(@ARGV);
+
+our ($opt_d2b, $opt_d2o, $opt_d2h, $opt_hd, $opt_od, $opt_bd, @to_ascii);
+GetOptions('db' => \$opt_d2b,
+ 'do' => \$opt_d2o,
+ 'dh' => \$opt_d2h,
+ 'hd' => \$opt_hd,
+ 'od' => \$opt_od,
+ 'bd' => \$opt_bd,
+ );
+
+my $int = shift;
+print convert($int), "\n";
+
+sub convert {
+ my $int = shift;
+ return sprintf("%b",$int, $int) if $opt_d2b;
+ return sprintf("%o",$int, $int) if $opt_d2o;
+ return sprintf("%x",$int, $int) if $opt_d2h;
+ return hex($int) if $opt_hd;
+ return oct($int) if $opt_od;
+ return oct("0b$int") if $opt_bd;
+}
+
+sub usage {
+ print << "USAGE";
+ USAGE: $0 [OPTIONS] integer
+ OPTIONS:
+ -db decimal to binary
+ -do decimal to octal
+ -dh decimal to hexadecimal
+ -hd hexadecimal to decimal
+ -od octal to decimal
+ -bd binary to decimal
+
+USAGE
+exit(0);
+}
14 cpmpd
View
@@ -0,0 +1,14 @@
+#!/bin/bash
+# transfer the playing song on the remote mpd server to the local box
+
+target="$HOME/ToTransfer/"
+if [ $@ ]; then
+ target="$@"
+fi
+
+base='/mnt/Music_1'
+file=$(mpc -h 192.168.1.101 --format %file%|head -1)
+path="'$base/$file'"
+basename=$(echo $path|perl -pe 's;.+/(.+)$;$1;')
+printf "\e[1m%s\e[0m => \e[31m%s\e[0m\n" $basename $target
+scp -P 19216 scp1@192.168.1.101:$path $target
36 cpnewfavs
View
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+# cpnewfavs - copy todays favorites to the portable player
+use File::Copy;
+
+my $basedir = '/mnt/Music_1';
+my $listdir = "$basedir/Playlists";
+my $target = "/mnt/mp3/MUSIC";
+
+my(undef, undef, undef, $mday, $mon, $year) = localtime(time);
+$mon += 1;
+$year += 1900;
+
+my $playlist = sprintf("%d-%02d-%02d_history.m3u",
+ $year, $mon, $mday);
+
+open(my $cat, '<', "$listdir/$playlist")
+ or die($!);
+
+while(<$cat>) {
+ chomp;
+ my $file = "$basedir/$_";
+ #$file =~ s/([;<>\*\|`&\$!#\(\)\[\]\{\}:'"])/\\$1/g;
+
+
+ if(copy($file, $target)) {
+ my($basename) = $file =~ m;.+/(.+)$;;
+ printf("\e[33;1m%30.30s\e[0m => \e[1m%s\e[0m\n",
+ $basename, $target);
+ }
+ else {
+ print STDERR "copy $file: $!\n";
+ }
+}
+
+close($cat); # be nice
+
68 crossmake
View
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+use strict;
+# crossmake - Makes cross's in all kinds of shapes and colors
+
+use encoding 'utf8';
+use Getopt::Long;
+use List::Util qw(shuffle);
+
+our($color,$char,$space,$size);
+GetOptions('color!' => \$color,
+ 'char=s' => \$char,
+ 'space=s' => \$space,
+ 'size=i' => \$size,
+ 'help' => \&help,
+ );
+my @colors;
+
+for(my $i=0;$i<256;$i++) {
+ push(@colors, "\033[38;5;$i"."m");
+}
+
+my @chars = qw([♥] ♥ o O x X);
+my @space = ('', '', '#');
+@chars = shuffle(@chars);
+@space = shuffle(@space);
+
+my $token = $char // $chars[0];
+my $ws = $space // $space[0];
+my $count = $size // 8;
+my $c = "\033[0m";
+for(my $i=0; $i<$count; ++$i) {
+ if($i%2==0) {
+ @colors = shuffle(@colors);
+ $c = $colors[0] unless(!$color);
+ }
+ else {
+ @colors = shuffle(@colors);
+ $c = $colors[0] unless(!$color);
+ }
+ my $j = 2 * $count - $i * 2;
+ print $c, $ws x $i, $token, $ws x $j, $token, $ws x $i, "\n";
+}
+for(my $i=$count; $i>0; --$i) {
+ if($i%2==0) {
+ @colors = shuffle(@colors);
+ $c = $colors[0] unless(!$color);
+ }
+ else {
+ @colors = shuffle(@colors);
+ $c = $colors[0] unless(!$color);
+ }
+ my $j = 2 * $count - $i * 2;
+ print $c, $ws x $i, $token, $ws x $j, $token, $ws x $i, "\n";
+}
+
+sub help {
+ print << "HLEP";
+ USAGE
+ $0 [OPTIONS]
+ OPTIONS
+ --(no)color
+ --char char
+ --space " "
+ --size size of painting
+HLEP
+exit 0;
+}
+
68 ddg
View
@@ -4,72 +4,30 @@ my $APP = 'ddg';
$VERSION = '0.004';
use strict;
-use JSON::XS;
-use LWP::Simple;
use encoding 'utf8';
use Term::ExtendedColor qw(fg bg);
-#use Data::Dumper;
-#
-#{
-# package Data::Dumper;
-# no strict 'vars';
-# $Terse = $Indent = $Useqq = $Deparse = $Sortkeys = 1;
-# $Quotekeys = 0;
-#}
-
-my $query = shift // 'perl';
-my $base = "http://api.duckduckgo.com/?q=$query&o=json";
-
-my $reply = get($base);
-my $struct = decode_json($reply);
-
-#print Dumper $struct;
-
-
-if(my $r = results()) {
- print bg('green27', fg('bold', fg('gray21', $query))) . " is:\n";
- printf("· %s %s\n",
- $r->{Text}, "($r->{FirstURL})",
- );
-
-
-}
-
-if(scalar(@{$struct->{RelatedTopics}}) > 0) {
- print 'Related to ' . hilight($query) . ": \n";
- printf("· %s\n· %s\n· %s\n· %s\n· %s\n",
- hilight($query, $struct->{RelatedTopics}->[0]->{Text}),
- hilight($query, $struct->{RelatedTopics}->[1]->{Text}),
- hilight($query, $struct->{RelatedTopics}->[2]->{Text}),
- hilight($query, $struct->{RelatedTopics}->[3]->{Text}),
- hilight($query, $struct->{RelatedTopics}->[4]->{Text}),
- hilight($query, $struct->{RelatedTopics}->[5]->{Text}),
- );
+use WWW::Search::DuckDuckGo qw(ddg);
+use Data::Dumper;
+
+{
+ package Data::Dumper;
+ no strict 'vars';
+ $Terse = $Indent = $Useqq = $Deparse = $Sortkeys = 1;
+ $Quotekeys = 0;
}
-printf("%s %s\n",
- hilight($query, $struct->{AbstractText}),
- "(@{[fg('blue2', $struct->{AbstractSource})]})",
-) unless $struct->{AbstractText} eq '';
+my $query = shift // "perl";
+my $results = ddg($query);
-sub hilight {
- my($term, $data) = @_;
- return fg('bold', fg('red1', $term)) if !defined($data);
- if($data =~ m/($term)(.*)/gpi) {
- return ${^PREMATCH} . fg('bold', fg('red1', $1)) . $2;
+for my $type(keys(%{$results})) {
+ if($results->{$type} ne "") {
+ printf("%s: \e[38;5;32m%s\e[0m\n", $type, $results->{$type});
}
- return $data;
}
-sub results {
- if(exists($struct->{Results})) {
- return $struct->{Results}->[0];
- }
- return 0;
-}
29 deparse
View
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+use strict;
+use Deparse::Syntax qw(deparse);
+
+deparse(\&code);
+
+sub code {
+ no strict;
+ $|=3,141592;sub _
+ {print@_}sub o{_++$O[0
+ ];_ 0for 1..$#O}sub O{$;=int
+ $=/10,'0/^ ^';if($;<9)
+ {_$_ for @O;;@O=()
+ ;0}push @O,$;;0
+ ,;push@ O,'.'if
+ $^==1; 0;if($;
+ ==10){ print ,o,@O=(
+ )}}$~= 1000000 ;$-=10*
+ (q/@O= digits of pi =10/,1)
+ *int($~ /3)+1;$
+ _=2for@ ,[0..$-]
+ ,;for$^ (1..$~){
+ $:=$-;$O =0;until
+ ($:<0){$/= 2*$:+1;$/=
+ 10if$/==1;$==10*$,[$:]+$O;$,
+ [$:]=$=%$/;$O=int($=/$/
+ )*$:--,10}O}o
+}
+
62 digits
View
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+use vars qw($VERSION);
+my $APP = '';
+$VERSION = '0.001';
+
+use strict;
+use Data::Dumper;
+
+{
+ package Data::Dumper;
+ no strict 'vars';
+ $Terse = $Indent = $Useqq = $Deparse = $Sortkeys = 1;
+ $Quotekeys = 0;
+}
+
+use encoding 'utf8';
+use charnames qw(:full);
+
+
+for my $ord ( 0 .. 0x10ffff ) {
+ next unless chr($ord) =~ /\d/;
+ printf("%s %s %s\n", $ord, chr($ord), charnames::viacode($ord));
+}
+
+
+
+
+
+=pod
+
+=head1 NAME
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 OPTIONS
+
+=head1 AUTHOR
+
+ Magnus Woldrich
+ CPAN ID: WOLDRICH
+ magnus@trapd00r.se
+ http://japh.se
+
+=head1 REPORTING BUGS
+
+Report bugs on rt.cpan.org or to magnus@trapd00r.se
+
+=head1 COPYRIGHT
+
+Copyright (C) 2011 Magnus Woldrich. All right reserved.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
+
+
+# vim: set ts=2 et sw=2:
+
91 div_rule
View
@@ -0,0 +1,91 @@
+#!/usr/bin/perl
+use strict;
+
+my $foo = shift // 1024;
+
+div_one($foo);
+div_two($foo);
+div_three($foo);
+div_five($foo);
+div_six($foo);
+div_seven($foo);
+div_eight($foo);
+div_nine($foo);
+div_ten($foo);
+
+sub div_one {
+ $_ = shift;
+ printf("%d/1: \e[1mpositive\e[0m\n", $_);
+}
+
+sub div_two {
+ $_ = shift;
+ if(($_ =~ m/.*(\d)/) and ($1 % 2 == 0)) {
+ printf("%d/2: \e[1mpositive\e[0m\n", $_);
+ }
+}
+
+sub div_three {
+ $_ = shift;
+ (my @c = $_) =~ /(\d)/g;
+ my $m = 0;
+ for(@c) {
+ $m += $_;
+ }
+ if($m % 3 == 0) {
+ printf("(%s)/3: \e[1mpositive\e[0m\n", join('+', @c));
+ }
+}
+
+sub div_five {
+ $_ = shift;
+ if((m/.*(\d)$/) and ($1 == 5) or ($1 == 0)) {
+ printf("%d/5: \e[1mpositive\e[0m\n", $_);
+ }
+}
+
+sub div_six {
+ $_ = shift;
+ if(($_ % 3 == 0) and ($_ % 2 == 0)) {
+ printf("%d/6: \e[1mpositive\e[0m\n", $_);
+ }
+}
+
+sub div_seven {
+ $_ = shift;
+ my $x = substr($_, -1, 1);
+ $_ =~ s/$x$//;
+ $_ = ($_ + $x);
+ if($_ % 7 == 0) {
+ printf("($_+$x)/7: \e[1mpositive\e[0m\n");
+ }
+}
+
+sub div_eight {
+ $_ = shift;
+ my $x = substr($_, -1, 1);
+ $_ =~ s/$x$//;
+ $_ = ($_ * 2) + $x;
+ if($_ % 8 == 0) {
+ printf("($_*2)+$x/8: \e[1mpositive\e[0m\n");
+ }
+}
+
+sub div_nine {
+ $_ = shift;
+ my @c = $_ =~ /(\d)/g;
+ my $m = 0;
+ for(@c) {
+ $m += $_;
+ }
+ if($m % 9 == 0) {
+ printf("(%s)/9: \e[1mpositive\e[0m\n", join('+', @c));
+ }
+}
+
+sub div_ten {
+ $_ = shift;
+ if((m/.*(\d)$/) and ($1 == 5) or ($1 == 0)) {
+ printf("%d/10: \e[1mpositive\e[0m\n", $_);
+ }
+}
0  dmenushit 100644 → 100755
View
File mode changed
51 dmesg
View
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+# dmesg.pl
+use strict;
+
+chomp(my @dmesg = `dmesg`);
+
+my %c = (
+ def => "\033[0m",
+ bold => "\033[1m",
+ italic => "\033[3m",
+
+ blue => "\033[38;5;29m",
+ green => "\033[38;5;148m",
+ red => "\033[38;5;196m",
+ grey => "\033[38;5;240m",
+);
+
+
+for(@dmesg) {
+ if(/(.+: \[)(sd[a-z])(\].+)/) {
+ print "$1$c{bold}$c{green}$2$c{def}$3\n";
+ }
+ elsif(/((?:wlan|eth))([0-9])(.+)/) {
+ printf("$c{bold}$c{grey}%4s$c{blue}$2$c{def}$3\n",
+ $1);
+ }
+ elsif(/^usb/) {
+ print $_ = "\033[38;5;106m$_\033[0m", "\n";;
+ }
+ elsif(/^TCP/) {
+ print $_ = "\033[38;5;202m$_\033[0m", "\n";
+ }
+ elsif(/^ACPI/) {
+ print $_ = "\033[38;5;80m$_\033[0m", "\n";
+ }
+ elsif(/^ata[0-9+]/) {
+ print $_ = "\033[38;5;99m$_\033[0m", "\n";
+ }
+ elsif(/^(input:)(.+)/) {
+ print "\033[38;5;196m\033[1m$1\033[0m\033[38;5;202m$2\033[0m", "\n";
+ }
+ elsif(/^(.+): (segfault)( .+)/) {
+ print "\033[38;5;160m$1\033[0m\033[1m:\033[48;5;160m$2\033[1m$3\033[0m\n";
+ }
+# elsif(/(.+not.+)/) {
+# print "$c{red}$1$c{def}\n";
+# }
+ else {
+ print "$_\n";
+ }
+}
102 filebytype
View
@@ -0,0 +1,102 @@
+#!/usr/bin/perl
+# fbft - move files to dirs compelling to actual file-type
+=zup?
+ 12-a.mp3 => audio/mpeg
+ 12-e.mp3 => audio/mpeg
+ 12-j.mp3 => audio/mpeg
+ 12-s.mp3 => audio/mpeg
+ a.out => application/x-executable
+ .bashrc => text/plain
+ bubble.pl => text/plain
+ cobalt.pl => text/plain
+ fileident.pl => text/plain
+ filemagic.pl => text/x-perl
+ .fonts.conf => application/xml
+ foobar => text/plain
+ foo.c => text/x-c
+ foo.sh => text/x-shellscript
+ .gtkrc-2.0 => text/plain
+ menu.pl => text/plain
+ menu.pl.tar => application/x-tar
+ menu.pl.tar.gz => application/x-gzip
+ menu.png => image/png
+ .muttrc => text/plain
+ .procmailrc => text/plain
+ .ratpoisonrc => text/x-c++; charset=us-ascii
+ .rtorrent.rc => text/plain
+ .sbclrc => text/plain
+ .screenrc => text/plain
+ .screenrc-dvdc => text/plain
+ .stumpwmrc => text/x-lisp
+ .toprc => text/plain
+ .urlview => text/plain
+ .vimperatorrc => text/plain
+ .vimrc => text/plain
+ .xinitrc => text/plain
+ .Xresources => text/x-c
+0 files were skipped.
+=cut
+
+use strict;
+use File::LibMagic;
+use File::Copy;
+use File::Path qw(make_path);
+use File::Basename;
+use Getopt::Long;
+use Data::Dumper;
+use Carp;
+use Cwd 'abs_path';
+
+my $magic = File::LibMagic->new;
+
+our($opt_symlink,$opt_copy,$opt_move);
+GetOptions(
+ 'symlink|ln' => \$opt_symlink,
+ 'copy|cp' => \$opt_copy,
+ 'move|mv' => \$opt_move,
+);
+my @files = @ARGV or yell("I need files!") and die;
+
+checkft(@files);
+
+sub checkft {
+ my @files = @_;
+ my $unwanted = 0;
+
+ for my $file(@files) {
+ my $ft = $magic->checktype_filename($file);
+ $ft =~ s/([a-z\/-]+);.+/$1/;
+
+ if($ft eq 'appliaction/x-directory') {
+ $unwanted++;
+ next;
+ }
+
+ if(!-d $ft) {
+ if(!$opt_symlink and !$opt_copy and !$opt_move) {
+ print "make_path($ft)\n";
+ next;
+ }
+ # if the mimetype does not exist as a possibly arbitary level of subdirs,
+ # We'll have to create it (mostly ./foo/bar)
+ make_path($ft);
+ }
+ if($opt_symlink) {
+ symlink(abs_path($file), "$ft/$file") or die $!;
+ print "symlink($file, $ft/$file)\n";
+ }
+ elsif($opt_move) {
+ move($file, $ft);
+ print "move($file, $ft)\n";
+ }
+ elsif($opt_copy) {
+ copy($file, $ft) or die $!;
+ print "copy($file, $ft)\n";
+ }
+ }
+}
+
+sub yell {
+ my $msg = shift;
+ print "\033[1m$msg\033[0m\n";
+}
0  filetypes 100644 → 100755
View
File mode changed
20 fimpc
View
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+use strict;
+# fimpc.. using fifos to control mpd using mpc. PoC.
+
+sub readFifo {
+ my $FIFO = shift;
+ while(1) {
+ unless(-p $FIFO) {
+ unlink $FIFO;
+ system('mknod', $FIFO, 'p');
+ }
+ open(FIFOR, "< $FIFO") or die "Cannot read $FIFO: $!\n";
+ while(<FIFOR>) {
+ my $cmd = $_;
+ system("mpc $cmd");
+ }
+ }
+}
+
+&readFifo('/tmp/tompc');
63 fullwidth
View
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+use vars qw($VERSION);
+my $APP = '';
+$VERSION = '0.001';
+
+use strict;
+use Data::Dumper;
+
+{
+ package Data::Dumper;
+ no strict 'vars';
+ $Terse = $Indent = $Useqq = $Deparse = $Sortkeys = 1;
+ $Quotekeys = 0;
+}
+
+use encoding 'utf8';
+use charnames qw(:full);
+
+
+for my $ord ( 0 .. 0x10ffff ) {
+ #next unless chr($ord) =~ /[[:punct:]]/;
+ printf("%s %s %s\n", $ord, chr($ord), charnames::viacode($ord))
+ if charnames::viacode($ord) =~ m/fullwidth/i;
+}
+
+
+
+
+
+=pod
+
+=head1 NAME
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 OPTIONS
+
+=head1 AUTHOR
+
+ Magnus Woldrich
+ CPAN ID: WOLDRICH
+ magnus@trapd00r.se
+ http://japh.se
+
+=head1 REPORTING BUGS
+
+Report bugs on rt.cpan.org or to magnus@trapd00r.se
+
+=head1 COPYRIGHT
+
+Copyright (C) 2011 Magnus Woldrich. All right reserved.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
+
+
+# vim: set ts=2 et sw=2:
+
125 generate_xresources
View
@@ -0,0 +1,125 @@
+#!/usr/bin/perl
+# Generate a hash with colorschemes from X resources
+use vars qw($VERSION);
+my $APP = '';
+$VERSION = '0.003';
+
+use strict;
+use Data::Dumper;
+
+{
+ package Data::Dumper;
+ no strict 'vars';
+ $Terse = $Indent = $Useqq = $Deparse = $Sortkeys = 1;
+ $Quotekeys = 0;
+}
+
+my $colors;
+
+for my $file(@ARGV) {
+ open(my $fh, '<', $file) or die($!);
+ chomp( my @r = <$fh> );
+
+ @r = grep{/(\*color\d+:\s*#.+)/} @r;
+
+ for my $l(@r) {
+ print $l, "\n";
+ if($l =~ m/!?(?:\w+)?\*color(\d+):\s*#(.+)/) {
+ $colors->{$file}->{$1} = $2;
+ }
+ }
+}
+
+print Dumper $colors;
+
+
+
+__DATA__
+! .Xdefaults
+! <hcarvalhoalves@archlinux.us>
+
+! Colour scheme
+*background:#1a1a1a
+*foreground:#fff
+*highlightColor:#444
+*color0:#000000
+*color1:#ff6565
+*color2:#93d44f
+*color3:#eab93d
+*color4:#204a87
+*color5:#ce5c00
+*color6:#89b6e2
+*color7:#cccccc
+*color8:#555753
+*color9:#ff8d8d
+*color10:#c8e7a8
+*color11:#ffc123
+*color12:#3465a4
+*color13:#f57900
+*color14:#46a4ff
+*color15:#ffffff
+
+! Xft resources
+Xft.antialias:true
+Xft.dpi:96
+Xft.hinting:true
+! hintslight | hintsmedium | hintsfull
+Xft.hintstyle:hintslight
+! rgba subpixel hinting (for LCDs)
+Xft.rgba:none
+
+! Xterm resources
+
+! Xft font name style
+XTerm*faceName:Liberation Mono
+XTerm*faceSize:9
+! Enable 256 color
+XTerm*termName:xterm-color
+XTerm*cursorBlink:false
+XTerm*utf8:1
+XTerm*loginShell:true
+! Fix some input and <Alt> for ncurses
+XTerm*eightBitInput:false
+XTerm*altSendsEscape:true
+! Matches selection for URLs and emails when double-click
+XTerm*charClass: 33:48,37-38:48,45-47:48,64:48,58:48,126:48,61:48,63:48,43:48,35:38
+XTerm*trimSelection: true
+
+! Sets Xcursor theme (installed under /usr/share/icons/ or ~/.icons/)
+Xcursor.theme:Vanilla-DMZ-AA
+
+
+=pod
+
+=head1 NAME
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 OPTIONS
+
+=head1 AUTHOR
+
+ Magnus Woldrich
+ CPAN ID: WOLDRICH
+ magnus@trapd00r.se
+ http://japh.se
+
+=head1 REPORTING BUGS
+
+Report bugs on rt.cpan.org or to magnus@trapd00r.se
+
+=head1 COPYRIGHT
+
+Copyright (C) 2011 Magnus Woldrich. All right reserved.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
+
+
+# vim: set ts=2 et sw=2:
+
131 git-rec
View
@@ -0,0 +1,131 @@
+#!/usr/bin/perl
+our $APP = 'git-rec';
+our $VERSION = 0.1;
+
+use strict;
+use Getopt::Long;
+use Pod::Usage;
+
+usage() if !@ARGV;
+
+our($cmd, $dir, $branch) = (undef) x 3;
+GetOptions(
+ 'cmd:s' => \$cmd,
+ 'dir:s' => \$dir,
+ 'branch:s' => \$branch,
+);
+
+($cmd) = $cmd ? $cmd : 'pull';
+($dir) = $dir ? $dir : "$ENV{HOME}/devel";
+($branch) = $branch ? $branch : 'origin master';
+
+
+cmd($dir, $cmd);
+
+sub cmd {
+ my($start, $operation) = @_;
+ $start =~ s;/$;;;
+
+ my @content = grep{! /(?:\.\.?)$/ }<$start/.* $start/*>;
+
+ for(@content) {
+ if(-d $_) {
+ if($_ =~ /\.git$/) {
+ my ($basename) = $_ =~ m;(.+)/\.git;;
+ my ($project) = $_ =~ m;.+/(.+)/\.git;;
+
+ my $status = undef;
+
+ if($operation eq 'pull') {
+ chomp($status = `cd $basename && git $cmd $branch 2> /dev/null`);
+
+ if($status =~ /Already up-to-date\./) {
+ printf("\e[1m::\e[38;5;178m %s\e[0m\n\e[38;5;34m Up to date\e[0m\n", $project);
+ next;
+ }
+ else {
+ printf("\e[1m::\e[38;5;178m %s\e[0m - \e[38;5;162mPulling\e[0m\n", $project);
+ print "$status\n";
+ next;
+ }
+ }
+ elsif($operation eq 'status') {
+ my @records;
+ chomp(@records = `cd $basename && git status -s`);
+ @records = git_status(@records);
+ printf("\e[1m::\e[38;5;178m %s\e[0m\n", $project);
+ printf(" %s\n", $_) for @records;
+ }
+
+ elsif($operation eq 'log') {
+ my @records;
+ chomp(@records = `cd $basename && git --no-pager log`);
+ @records = git_log(@records);
+ print "$_\n" for @records;
+ }
+ else {
+ print $operation;
+ }
+ }
+ else {
+ cmd($_, $operation);
+ }
+ }
+ }
+ return 0;
+}
+
+sub git_status {
+ for(@_) {
+ s/^\?\? (.+)$/\e[38;5;137m\e[1mUntracked: \e[0m$1/gms;
+ s/^ M (.+)$/\e[38;5;34m\e[1m Modified: \e[0m$1\e[0m/gms;
+ s/^ D (.+)$/\e[38;5;244m\e[1m Deleted: \e[1m$1\e[0m/gms;
+ }
+ return(@_);
+}
+
+sub git_log {
+ for(@_) {
+ s/^(commit) (.+)$/\e[1m$1 \e[0m\e[3m\e[38;5;197m$2\e[0m/;
+ s/^(Author:) (.+) <(.+)>$/$1 \e[1m\e[38;5;65m$2\e[0m < \e[38;5;208m$3\e[0m >\e[0m/;
+ s/^(Date) (.+)$/\e[1m$1 \e[0m\e[3m$2\e[0m/;
+ s/^\s+ (.+)/\e[38;5;249m\t$1\e[0m/;
+ }
+ return(@_);
+}
+
+sub usage {
+ print "$APP $VERSION\n";
+ pod2usage(verbose => 1);
+ exit(0);
+}
+
+=pod
+
+=head1 NAME
+
+git-rec - do git stuff recursively
+
+=head1 DESCRIPTION
+
+=head1 OPTIONS
+
+ -c, --cmd git cmd
+ -d, --dir start dir
+ -b, --branch branch
+
+=head1 AUTHOR
+
+Written by Magnus Woldrich
+
+=head1 REPORTING BUGS
+
+Report bugs to trapd00r@trapd00r.se
+
+=head1 COPYRIGHT
+
+Copyright (C) 2010 Magnus Woldrich
+
+License GPLv2
+
+=cut
10 google_dmenu
View
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+# google_dmenu.pl
+# thanks to Gazj for the original bash version
+use strict;
+
+my $dmenu = 'dmenu -i -b -nb #1c1c1c -nf #d7005f -sb #252525';
+my $d_cmd = `$dmenu -p search`;
+
+system("firefox -new-window http://google.com/search?q=$d_cmd")
+ unless !$d_cmd;
212 google_tlds
View
@@ -0,0 +1,212 @@
+#!/usr/bin/perl
+# dump google TLDs
+use strict;
+
+use Data::Dumper;
+$Data::Dumper::Terse = 1;
+$Data::Dumper::Indent = 1;
+$Data::Dumper::Useqq = 1;
+$Data::Dumper::Deparse = 1;
+$Data::Dumper::Quotekeys = 0;
+$Data::Dumper::Sortkeys = 1;
+
+my $tld;
+
+while(my $d = <DATA>) {
+ chomp $d;
+ if($d =~ m/.+[.]([a-z]+)\z/) {
+ my $t = $1;
+ my ($base) = $d =~ m/^[.](.+)$/;
+ $tld->{$t}->{url} = $base;
+ }
+}
+
+print Dumper $tld;
+
+
+
+__DATA__
+.google.com
+.google.ad
+.google.ae
+.google.com.af
+.google.com.ag
+.google.com.ai
+.google.am
+.google.co.ao
+.google.com.ar
+.google.as
+.google.at
+.google.com.au
+.google.az
+.google.ba
+.google.com.bd
+.google.be
+.google.bf
+.google.bg
+.google.com.bh
+.google.bi
+.google.bj
+.google.com.bn
+.google.com.bo
+.google.com.br
+.google.bs
+.google.co.bw
+.google.by
+.google.com.bz
+.google.ca
+.google.cd
+.google.cf
+.google.cg
+.google.ch
+.google.ci
+.google.co.ck
+.google.cl
+.google.cm
+.google.cn
+.google.com.co
+.google.co.cr
+.google.com.cu
+.google.cz
+.google.de
+.google.dj
+.google.dk
+.google.dm
+.google.com.do
+.google.dz
+.google.com.ec
+.google.ee
+.google.com.eg
+.google.es
+.google.com.et
+.google.fi
+.google.com.fj
+.google.fm
+.google.fr
+.google.ga
+.google.ge
+.google.gg
+.google.com.gh
+.google.com.gi
+.google.gl
+.google.gm
+.google.gp
+.google.gr
+.google.com.gt
+.google.gy
+.google.com.hk
+.google.hn
+.google.hr
+.google.ht
+.google.hu
+.google.co.id
+.google.ie
+.google.co.il
+.google.im
+.google.co.in
+.google.is
+.google.it
+.google.je
+.google.com.jm
+.google.jo
+.google.co.jp
+.google.co.ke
+.google.com.kh
+.google.ki
+.google.kg
+.google.co.kr
+.google.com.kw
+.google.kz
+.google.la
+.google.com.lb
+.google.li
+.google.lk
+.google.co.ls
+.google.lt
+.google.lu
+.google.lv
+.google.com.ly
+.google.co.ma
+.google.md
+.google.me
+.google.mg
+.google.mk
+.google.ml
+.google.mn
+.google.ms
+.google.com.mt
+.google.mu
+.google.mv
+.google.mw
+.google.com.mx
+.google.com.my
+.google.co.mz
+.google.com.na
+.google.com.nf
+.google.com.ng
+.google.com.ni
+.google.ne
+.google.nl
+.google.no
+.google.com.np
+.google.nr
+.google.nu
+.google.co.nz
+.google.com.om
+.google.com.pa
+.google.com.pe
+.google.com.ph
+.google.com.pk
+.google.pl
+.google.pn
+.google.com.pr
+.google.ps
+.google.pt
+.google.com.py
+.google.com.qa
+.google.ro
+.google.ru
+.google.rw
+.google.com.sa
+.google.com.sb
+.google.sc
+.google.se
+.google.com.sg
+.google.sh
+.google.si
+.google.sk
+.google.com.sl
+.google.sn
+.google.sm
+.google.st
+.google.com.sv
+.google.td
+.google.tg
+.google.co.th
+.google.com.tj
+.google.tk
+.google.tl
+.google.tm
+.google.to
+.google.com.tr
+.google.tt
+.google.com.tw
+.google.co.tz
+.google.com.ua
+.google.co.ug
+.google.co.uk
+.google.com.uy
+.google.co.uz
+.google.com.vc
+.google.co.ve
+.google.vg
+.google.co.vi
+.google.com.vn
+.google.vu
+.google.ws
+.google.rs
+.google.co.za
+.google.co.zm
+.google.co.zw
+.google.cat
+
11 grmpd
View
@@ -0,0 +1,11 @@
+#!/bin/bash
+# copy the playing track from remote mpd session to local machine
+# This was sexier in Perl, but Net::SCP is retarded and wraps scp anyway
+
+if [ $@ ]; then
+ dir=$@;
+else
+ dir='.';
+fi
+
+scp -P 19216 "192.168.1.101:'/mnt/Music_1/$(mpc -h 192.168.1.101 --format %file%|head -1)'" $dir
65 httpdhits
View
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+# httpdhits
+use strict;
+use Data::Dumper;
+
+my $color = 1;
+my $cmd = shift // 'f';
+my $log = shift // '/var/log/lighttpd/access.log';
+
+my $noc = "\033[0m";
+my $clr1 = "\033[38;5;100m";
+my $clr2 = "\033[38;5;197m";
+$clr1 = $noc unless $color == 1;
+$clr2 = $noc unless $color == 1;
+
+open(my $fh, '<', $log) or die "Cant open $log: $!";
+
+my(%ips, %reqfiles);
+
+while(my $line = <$fh>) {
+ my $re = '(.+?)';
+ $line =~ /^$re $re $re \[$re:$re $re\] "$re $re $re" $re $re/;
+
+ my $ip = $1;
+ my $ref = $2;
+ my $name = $3;
+ my $date = $4;
+ my $time = $5;
+ my $gmt = $6;
+ my $req = $7;
+ my $file = $8;
+ my $ptcl = $9;
+ my $code = $10;
+ my $size = $11;
+
+ $ips{$ip}++;
+ $reqfiles{$file}++;
+}
+
+my %opts = (
+ f => sub { popfiles(); },
+ i => sub { popips(); },
+ h => sub { print "f\trequested files\ni\tIP adresses making the requests\n";},
+);
+
+defined($opts{$cmd}) && $opts{$cmd}->();
+
+sub popips {
+ my $sum;
+ for my $ip(sort {$ips{$a} <=> $ips{$b}} keys(%ips)) {
+ printf("$clr1% 5d$noc %s\n", $ips{$ip}, $ip);
+ $sum += $ips{$ip};
+ }
+ printf("$clr2%6d$noc IP Adresses\n", $sum);
+}
+
+sub popfiles {
+ my $sum;
+ for my $file(sort {$reqfiles{$a}<=> $reqfiles{$b}} keys(%reqfiles)) {
+ printf("$clr1% 5d$noc %s\n", $reqfiles{$file}, $file);
+ $sum += $reqfiles{$file};
+ }
+ printf("$clr2%6d$noc requests\n", $sum);
+}
+
88 imv
View
@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+# imv - watch a dir and scp all created files therein to another host
+use strict;
+use Linux::Inotify2;
+use Getopt::Long;
+
+my $DEBUG = 0;
+
+my $dest = '/mnt/Music_3/.torrents/';
+my $log = "$ENV{HOME}/.mvtorrents.log";
+my $pidfile = '/tmp/mvtorrents.pid';
+
+
+GetOptions(
+ k => \&killkid,
+ d => \$DEBUG,
+);
+
+my $what = shift // "$ENV{HOME}/TorrentsToServer";
+
+if(!-d $what) {
+ print STDERR "$what is not a directory, bye\n";
+ exit(1);
+}
+
+daemonize($log) unless($DEBUG);
+watch($what);
+
+sub watch {
+ my $dir = shift;
+ my $n = Linux::Inotify2->new;
+
+ $n->watch($dir, IN_CREATE) or die($!);
+
+
+ while(my @events = $n->read) {
+ for my $event(@events) {
+ sleep 2;
+ if($event->{name} =~ m/\.torrent$/) {
+ print localtime(time) . "\tIN_CREATE\t$event->{name} => $dest\n";
+ system("scp -P 19216 $what/$event->{name} scp1\@192.168.1.100:$dest");
+ }
+ }
+ }
+ return 0;
+}
+
+sub daemonize {
+ my $daemon_log = shift // '/dev/null';
+ use POSIX 'setsid';
+ my $PID = fork();
+ exit(0) if($PID); #parent
+ exit(1) if(!defined($PID)); # out of resources
+
+ setsid();
+ $PID = fork();
+ exit(1) if(!defined($PID));
+
+ if($PID) { # parent
+ waitpid($PID, 0);
+ unlink($pidfile); # remove the lock when child have died
+ exit(0);
+ }
+ elsif($PID == 0) { # child
+ open(my $fh, '>', $pidfile) or die("Cant open $pidfile: $!");
+ print $fh $$;
+ close($fh);
+ open(STDOUT, '>', $daemon_log);
+ open(STDERR, '>', '/dev/null');
+ open(STDIN, '<', '/dev/null');
+ }
+}
+
+sub killkid {
+ open(my $fh, '<', $pidfile) or print "imv is not running\n" and exit(1);
+ my $target = <$fh>;
+ close($fh);
+
+ if(kill(9, $target)) {
+ print "imv with PID $target terminated\n";
+ }
+ else {
+ print "Could not kill $target: $!";
+ }
+ exit(0);
+}
+
+
75 iterate
View
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+use strict;
+use Getopt::Long;
+use Pod::Usage;
+
+usage() if(!@ARGV);
+
+our ($opt_count, $opt_perl, $opt_newline) = (10, 0, 0);
+GetOptions(
+ 'count:i' => \$opt_count,
+ 'perl' => \$opt_perl,
+ 'newline' => \$opt_newline,
+ 'help' => sub { pod2usage(verbose => 1); },
+);
+
+my $torun = shift // undef;
+
+iterate($opt_count, $torun);
+
+sub iterate {
+ my $count = shift;
+ my $cmd = join(' ', @_);
+
+ my $i;
+ my @foo;
+
+ my $error = 0;
+ PERL_CMD:
+ if($opt_perl) {
+ if($error) {
+ print "\e[1m\e[38;5;160m> \e[38;5;197m";
+ }
+ else {
+ print "\e[1m\e[36m> \e[38;5;197m";
+ }
+ chomp($cmd = <STDIN>);
+ print "\e[0m";
+ }
+ for($i=0; $i<$count; ++$i) {
+ if($opt_perl) {
+ my $foo = (eval($cmd));
+ if($@) {
+ print $@;
+ $error = 1;
+ goto PERL_CMD;
+ }
+ else {
+ $error = 0;
+ print $foo, "\n";
+ goto PERL_CMD;
+ }
+ }
+ else {
+ system("$cmd");
+ print "\n" unless(!$opt_newline);
+ }
+ }
+ return(0);
+}
+
+sub usage {
+ printf("iterate -c count (-pe perl code | command)\n");
+ exit(0);
+}
+
+=pod
+
+=head1 OPTIONS
+
+ -c, --count number of iterations
+ -n, --newline append newline to every line (default: OFF)
+ -p, --perl evaluate perl code
+ -h, --help show help and exit
+
+=cut
1  japh1277971998
View
@@ -0,0 +1 @@
+print($_->($_))for(sub{return(grep(!m$(?:[b-gik-oq-ty]+)$,split(m;;,qw-jyatopnh-)));});
40 laleh-check
View
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+# laleh-check.pl
+# check if string is present in Laleh's lyrics
+# 'candle' is present in Closer
+# 'and' is present in Call on Me
+# 'and' is present in Closer
+my $DEBUG = 0;
+
+use strict;
+use Audio::MPD;
+use feature 'say';
+use Data::Dumper;
+use Lyrics::Fetcher::LyricWiki;
+use utf8;
+
+my $laleh_string = shift // 'bitch';
+
+my $pass = `smokingkills`;
+
+my $mpd = Audio::MPD->new(
+ host => '192.168.1.101',
+ port => 6600,
+ pass => $pass,
+);
+
+my %laleh;
+my @songs = ();
+push(@songs, $_->title) for($mpd->collection->songs_by_artist('Laleh'));
+
+s/(\w+)/\u\L$1/g for @songs;
+
+$laleh{$_} = Lyrics::Fetcher::LyricWiki->fetch('Laleh', $_) for @songs;
+
+print Dumper \%laleh if($DEBUG);
+
+for my $s(keys(%laleh)) {
+ if($laleh{$s} =~ /$laleh_string/gi) {
+ say "'$laleh_string' is present in $s";
+ }
+}
0  lib/Net::Google::TLD/blib/arch/.exists
View
No changes.
0  lib/Net::Google::TLD/blib/arch/auto/Net/Google/TLD/.exists
View
No changes.
0  lib/Net::Google::TLD/blib/bin/.exists
View
No changes.
0  lib/Net::Google::TLD/blib/lib/Net/Google/.exists
View
No changes.
634 lib/Net::Google::TLD/blib/lib/Net/Google/TLD.pm
View
@@ -0,0 +1,634 @@
+#!/usr/bin/perl
+package Net::Google::TLD;
+
+use vars qw($VERSION);
+$VERSION = '0.001';
+
+BEGIN {
+ require Exporter;
+ our @ISA = 'Exporter';
+ our @EXPORT_OK = qw(get_url_by_tld);
+}
+
+use strict;
+#use Data::Dumper;
+#
+#{
+# package Data::Dumper;
+# no strict 'vars';
+# $Terse = $Indent = $Useqq = $Deparse = $Sortkeys = 1;
+# $Quotekeys = 0;
+#}
+
+my $google = {
+ ad => {
+ url => "google.ad"
+ },
+ ae => {
+ url => "google.ae"
+ },
+ af => {
+ url => "google.com.af"
+ },
+ ag => {
+ url => "google.com.ag"
+ },
+ ai => {
+ url => "google.com.ai"
+ },
+ am => {
+ url => "google.am"
+ },
+ ao => {
+ url => "google.co.ao"
+ },
+ ar => {
+ url => "google.com.ar"
+ },
+ as => {
+ url => "google.as"
+ },
+ at => {
+ url => "google.at"
+ },
+ au => {
+ url => "google.com.au"
+ },
+ az => {
+ url => "google.az"
+ },
+ ba => {
+ url => "google.ba"
+ },
+ bd => {
+ url => "google.com.bd"
+ },
+ be => {
+ url => "google.be"
+ },
+ bf => {
+ url => "google.bf"
+ },
+ bg => {
+ url => "google.bg"
+ },
+ bh => {
+ url => "google.com.bh"
+ },
+ bi => {
+ url => "google.bi"
+ },
+ bj => {
+ url => "google.bj"
+ },
+ bn => {
+ url => "google.com.bn"
+ },
+ bo => {
+ url => "google.com.bo"
+ },
+ br => {
+ url => "google.com.br"
+ },
+ bs => {
+ url => "google.bs"
+ },
+ bw => {
+ url => "google.co.bw"
+ },
+ by => {
+ url => "google.by"
+ },
+ bz => {
+ url => "google.com.bz"
+ },
+ ca => {
+ url => "google.ca"
+ },
+ cat => {
+ url => "google.cat"
+ },
+ cd => {
+ url => "google.cd"
+ },
+ cf => {
+ url => "google.cf"
+ },
+ cg => {
+ url => "google.cg"
+ },
+ ch => {
+ url => "google.ch"
+ },
+ ci => {
+ url => "google.ci"
+ },
+ ck => {
+ url => "google.co.ck"
+ },
+ cl => {
+ url => "google.cl"
+ },
+ cm => {
+ url => "google.cm"
+ },
+ cn => {
+ url => "google.cn"
+ },
+ co => {
+ url => "google.com.co"
+ },
+ com => {
+ url => "google.com"
+ },
+ cr => {
+ url => "google.co.cr"
+ },
+ cu => {
+ url => "google.com.cu"
+ },
+ cz => {
+ url => "google.cz"
+ },
+ de => {
+ url => "google.de"
+ },
+ dj => {
+ url => "google.dj"
+ },
+ dk => {
+ url => "google.dk"
+ },
+ dm => {
+ url => "google.dm"
+ },
+ do => {
+ url => "google.com.do"
+ },
+ dz => {
+ url => "google.dz"
+ },
+ ec => {
+ url => "google.com.ec"
+ },
+ ee => {
+ url => "google.ee"
+ },
+ eg => {
+ url => "google.com.eg"
+ },
+ es => {
+ url => "google.es"
+ },
+ et => {
+ url => "google.com.et"
+ },
+ fi => {
+ url => "google.fi"
+ },
+ fj => {
+ url => "google.com.fj"
+ },
+ fm => {
+ url => "google.fm"
+ },
+ fr => {
+ url => "google.fr"
+ },
+ ga => {
+ url => "google.ga"
+ },
+ ge => {
+ url => "google.ge"
+ },
+ gg => {
+ url => "google.gg"
+ },
+ gh => {
+ url => "google.com.gh"
+ },
+ gi => {
+ url => "google.com.gi"
+ },
+ gl => {
+ url => "google.gl"
+ },
+ gm => {
+ url => "google.gm"
+ },
+ gp => {
+ url => "google.gp"
+ },
+ gr => {
+ url => "google.gr"
+ },
+ gt => {
+ url => "google.com.gt"
+ },
+ gy => {
+ url => "google.gy"
+ },
+ hk => {
+ url => "google.com.hk"
+ },
+ hn => {
+ url => "google.hn"
+ },
+ hr => {
+ url => "google.hr"
+ },
+ ht => {
+ url => "google.ht"
+ },
+ hu => {
+ url => "google.hu"
+ },
+ id => {
+ url => "google.co.id"
+ },
+ ie => {
+ url => "google.ie"
+ },
+ il => {
+ url => "google.co.il"
+ },
+ im => {
+ url => "google.im"
+ },
+ in => {
+ url => "google.co.in"
+ },
+ is => {
+ url => "google.is"
+ },
+ it => {
+ url => "google.it"
+ },
+ je => {
+ url => "google.je"
+ },
+ jm => {
+ url => "google.com.jm"
+ },
+ jo => {
+ url => "google.jo"
+ },
+ jp => {
+ url => "google.co.jp"
+ },
+ ke => {
+ url => "google.co.ke"
+ },
+ kg => {
+ url => "google.kg"
+ },
+ kh => {
+ url => "google.com.kh"
+ },
+ ki => {
+ url => "google.ki"
+ },
+ kr => {
+ url => "google.co.kr"
+ },
+ kw => {
+ url => "google.com.kw"
+ },
+ kz => {
+ url => "google.kz"
+ },
+ la => {
+ url => "google.la"
+ },
+ lb => {
+ url => "google.com.lb"
+ },
+ li => {
+ url => "google.li"
+ },
+ lk => {
+ url => "google.lk"
+ },
+ ls => {
+ url => "google.co.ls"
+ },
+ lt => {
+ url => "google.lt"
+ },
+ lu => {
+ url => "google.lu"
+ },
+ lv => {
+ url => "google.lv"
+ },
+ ly => {
+ url => "google.com.ly"
+ },
+ ma => {
+ url => "google.co.ma"
+ },
+ md => {
+ url => "google.md"
+ },
+ me => {
+ url => "google.me"
+ },
+ mg => {
+ url => "google.mg"
+ },
+ mk => {
+ url => "google.mk"
+ },
+ ml => {
+ url => "google.ml"
+ },
+ mn => {
+ url => "google.mn"
+ },
+ ms => {
+ url => "google.ms"
+ },
+ mt => {
+ url => "google.com.mt"
+ },
+ mu => {
+ url => "google.mu"
+ },
+ mv => {
+ url => "google.mv"
+ },
+ mw => {
+ url => "google.mw"
+ },
+ mx => {
+ url => "google.com.mx"
+ },
+ my => {
+ url => "google.com.my"
+ },
+ mz => {
+ url => "google.co.mz"
+ },
+ na => {
+ url => "google.com.na"
+ },
+ ne => {
+ url => "google.ne"
+ },
+ nf => {
+ url => "google.com.nf"
+ },
+ ng => {
+ url => "google.com.ng"
+ },
+ ni => {
+ url => "google.com.ni"
+ },
+ nl => {
+ url => "google.nl"
+ },
+ no => {
+ url => "google.no"
+ },
+ np => {
+ url => "google.com.np"
+ },
+ nr => {
+ url => "google.nr"
+ },
+ nu => {
+ url => "google.nu"
+ },
+ nz => {
+ url => "google.co.nz"
+ },
+ om => {
+ url => "google.com.om"
+ },
+ pa => {
+ url => "google.com.pa"
+ },
+ pe => {
+ url => "google.com.pe"
+ },
+ ph => {
+ url => "google.com.ph"
+ },
+ pk => {
+ url => "google.com.pk"
+ },
+ pl => {
+ url => "google.pl"
+ },
+ pn => {
+ url => "google.pn"
+ },
+ pr => {
+ url => "google.com.pr"
+ },
+ ps => {
+ url => "google.ps"
+ },
+ pt => {
+ url => "google.pt"
+ },
+ py => {
+ url => "google.com.py"
+ },
+ qa => {
+ url => "google.com.qa"
+ },
+ ro => {
+ url => "google.ro"
+ },
+ rs => {
+ url => "google.rs"
+ },
+ ru => {
+ url => "google.ru"
+ },
+ rw => {
+ url => "google.rw"
+ },
+ sa => {
+ url => "google.com.sa"
+ },
+ sb => {
+ url => "google.com.sb"
+ },
+ sc => {
+ url => "google.sc"
+ },
+ se => {
+ url => "google.se"
+ },
+ sg => {
+ url => "google.com.sg"
+ },
+ sh => {
+ url => "google.sh"
+ },
+ si => {
+ url => "google.si"
+ },
+ sk => {
+ url => "google.sk"
+ },
+ sl => {
+ url => "google.com.sl"
+ },
+ sm => {
+ url => "google.sm"
+ },
+ sn => {
+ url => "google.sn"
+ },
+ st => {
+ url => "google.st"
+ },
+ sv => {
+ url => "google.com.sv"
+ },
+ td => {
+ url => "google.td"
+ },
+ tg => {
+ url => "google.tg"
+ },
+ th => {
+ url => "google.co.th"
+ },
+ tj => {
+ url => "google.com.tj"
+ },
+ tk => {
+ url => "google.tk"
+ },
+ tl => {
+ url => "google.tl"
+ },
+ tm => {
+ url => "google.tm"
+ },
+ to => {
+ url => "google.to"
+ },
+ tr => {
+ url => "google.com.tr"
+ },
+ tt => {
+ url => "google.tt"
+ },
+ tw => {
+ url => "google.com.tw"
+ },
+ tz => {
+ url => "google.co.tz"
+ },
+ ua => {
+ url => "google.com.ua"
+ },
+ ug => {
+ url => "google.co.ug"
+ },
+ uk => {
+ url => "google.co.uk"
+ },
+ uy => {
+ url => "google.com.uy"
+ },
+ uz => {
+ url => "google.co.uz"
+ },
+ vc => {
+ url => "google.com.vc"
+ },
+ ve => {
+ url => "google.co.ve"
+ },
+ vg => {
+ url => "google.vg"
+ },
+ vi => {
+ url => "google.co.vi"
+ },
+ vn => {
+ url => "google.com.vn"
+ },
+ vu => {
+ url => "google.vu"
+ },
+ ws => {
+ url => "google.ws"
+ },
+ za => {
+ url => "google.co.za"
+ },
+ zm => {
+ url => "google.co.zm"
+ },
+ zw => {