#!/usr/bin/perl
use strict;
use warnings;

# History:
# conray  - 19.02.2010 : 19:31 UTC - initial version with ping (-ping)
# betterworld - 19.02.2010 : 19:44 UTC - minor changes
# esskar  - 19.02.2010 : 20:27 UTC - changes on ping, and dump myself command (-dump)
# topeg  - 19.02.2010 : 00:02 UTC - addded mirror
# Kalle - 01.03.2010 - added technology assimilation automation
# conray - 02.02.2010 21:07 - added Helpfunktion (-help) and changes on Ping-Parameter
# conray - 03.02.2010 19:28 - added Password-Generator (-pwgen)
# conray - 08.03.2010 21:35 - added print location (-whereami)
# steferbo - 08.03.2010 23:10 - added get country from ip (-get_country)
# topeg - 09.03.2010 23:46 - changed to GetOpt::Long, adapt assimilate ping, pwgen and get_country, added dummy (--dummy), added truemirror (--truemirror <file|->)
# steferbo - 12.03.2010 22:30 - added steuern2010
# topeg - 16.03.2010 01:00 - added echo (--echo <txt>), added export (--export <option>), edit steuern2010, edit assimilate
# topeg - 16.03.2010 22:20 - edit export now you can choose to use B::Deparse or a regular expression to grep the code.
# conray - 23.04.2010 00:58 UTC added xxo - TicTacToe game
# conray - 05.05.2010 20:44 UTC added timer - let Speaker beep after userdefined minutes
# conray - 25.08.2010 14:42 UTC added cat - print file to STDOUT

use Getopt::Long;
use FindBin;
use Net::Ping;
use LWP::UserAgent;
use HTTP::Cookies;
use File::Basename;
use ProgressBar::Stack;

# <-- please don't touch this

#EierlegendeWollMilchSau.pl
my %opts=();
my @runn=();
my %commands=();
%commands=(
########################################################################
########################################################################

#_______________________________________________________________________
'dummy' => [
"dummy\t\tDoing nothing!",
sub {
  # empty.
}],
#_______________________________________________________________________
'echo=s,echannel=s,enonewline' => [
"echo <sting> [--echannel <STDOUT|STDERR|file>] [--enonewline]\t\tprint <string> to STDOUT|STDERR|file",
sub {
  my ($txt,$channel,$nnl)=@_;
  $txt='' unless(defined($txt));

  my $fh=\*STDOUT;
  if($channel)
  {
    if($channel eq 'STDERR')
    { $fh=\*STDERR; }
    elsif($channel ne 'STDOUT')
    { open($fh,'>',$channel) or die("ERROR open: $channel ($!)\n"); }
  }

  print $fh $txt,$nnl?'':"\n";
}],

#_______________________________________________________________________
'help|h' => [
"help\t\tprint out this usagetext",
sub{
  HELP();
},
'runn now'],

#_______________________________________________________________________
'ping=s,range=i' => [
"ping <ip> [--range=<range>]\t\ttrys to ping an ip or an range of ip addresses.",
sub
{
  my ($ip,$till) = @_;
  my @r = split(/\./, $ip);

  $till=$r[3] unless(defined($till));

  my $until = $till + 1;
  while ($r[3] < $until )
  {
    $ip = join '.', @r;
    my $ping = Net::Ping->new('icmp', 1, 64 );
    print "$ip " . ($ping->ping($ip) ? 'online' : 'offline') . "\n";
    $r[3]++;
  }
}],

#_______________________________________________________________________
'dump' => [
"dump\t\tdumps itself to STDOUT",
sub
{
  my $path = "$FindBin::Bin/$FindBin::Script";
  open(my $myself, "< $path") or die "Unable to open myself ($path): $!";
  while(<$myself>) { print $_; }
  close $myself;
}],

#_______________________________________________________________________
'devil' => [
"devil\t\tDon't try that",
sub
{
  print "So long, and thanks for all the fish.\n";
  unlink $0 or die "Will not stop :'-(\n";
}],

#_______________________________________________________________________
'mirror=s' => [
"mirror <file|->\t\tmirror file or STDIN",
sub
{
  my $fh=\*STDIN;
  my $file=shift;
  open($fh,'<',$file) || die("ERROR open $file ($!)") if($file && $file ne '-');
  chomp($_) && print reverse($_)."\n" while(<$fh>);
  close($fh);
}],

#_______________________________________________________________________
'truemirror=s' => [
"truemirror <file|->\t\tmirror file or STDIN",
sub
{
  my $fh=\*STDIN;
  my $file=shift;
  open($fh,'<',$file) || die("ERROR open $file ($!)") if($file && $file ne '-');
  my @lines=();
  my $length;
  while (my $line=<$fh>)
  {
    $length=length($line) if(!defined($length) || $length<length($line));
    chomp($line);
    $line=reverse($line);
    $line=~y/()[]{}\\\/`´<>/)(][}{\/\\´`></;
    push(@lines,$line);
  }
  printf("%${length}s\n",$_) for(@lines);
  close($fh);
}],

#_______________________________________________________________________
'assimilate=s,asshelptext=s' => [
"assimilate newparam.pl [--asshelptext <helptext>]\t\tassimilate more perl code into this script",
sub
{
  my $newtechsource=shift;
  my $helptext=shift || "assimilated weird stuff";
  my $borgtechnology;
  my $assimilationspace;
  my $newtechnology;
  my ($newcmdname)=split(/\./,$newtechsource,0);
  $newcmdname=~y/=|!?//d;
  $newcmdname=~s/\s+/_/s;
  my ($borgbase,$borgpath)=fileparse($0);
  my $newborgtechnology="${borgpath}Neue$borgbase";
  if (open($borgtechnology,'<',$0)) {
    if (open($assimilationspace,'>',$newborgtechnology)) {
      if (open($newtechnology,'<',$newtechsource)) {
        while(<$borgtechnology>) {
          if (/^# <-- don't touch this/) {
             my $thisline=$_;
             print "Assimiliere neue Technologie...\n";
             print $assimilationspace qq!
#_______________________________________________________________________
'$newcmdname' => [
"$newcmdname\\t\\t $helptext",
sub {
!;
             while(<$newtechnology>) {
               next if (/^#!|^use strict;|^use warnings;/);
               print $assimilationspace $_;
             }
             close($newtechnology);
             print $assimilationspace qq!
},
'runn now'],

$thisline!;
          }
          else {
            print $assimilationspace $_;
          }
        }
        close($borgtechnology);
        if (close($assimilationspace)) {
          print "Widerstand war zwecklos!\nNeue Technologie einsetzbar: Neue$borgbase --$newcmdname\n";
        }
        else {
          print "Aktivierungssequenz ungültig. Assimilation abgebrochen.\n";
        }
      }
      else {
        print "Neue Technologie kann nicht assimiliert werden. Abbruch der Assimilation\n";
      }
    }
    else {
      print "Fluktuation im temporären Raum-/Zeitgefüge. Abbruch der Assimilation.\n";
    }
  }
  else {
    print "Wo sind wir ? Es ist so....leise. Bring uns nach Hause!\n";
  }
}],

#_______________________________________________________________________
'pwgen=i' => [
"pwgen\t\tgenerates a (secure) password",
sub
{
  my $input=shift;
  unless($input)
  {
    print "How much positions your password should have?\n";
    print "Note: Secure passwords have 10 positions as minimum \n";
    $input=<STDIN>;
    chomp $input;
  }
  $input=~s/[^\-\d].+$//;
  $input=abs($input);

  my @bletters = ("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z");
  my @sletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z");
  my @numbers = ("1", "2", "3", "4", "5", "6", "7", "8", "9", "0");
  my @special = ("!", "\.", "\$", "\%", "\&", "?", "\/", "\\", "\,", "-", "_", "\#", "\*", ":", "(", ")", "=", "+", "<", "§", "[", "]", "\;");

  my $pw='';
  while (length($pw) != $input) {
     my $n1 = int(rand(26));
     my $n2 = int(rand(26));
     my $n3 = int(rand(10));
     my $n4 = int(rand(23));
     my $z = int(rand(4));
     if ($z == 0) {
        $pw = $pw . $bletters[$n1]; }
     elsif ($z == 1) {
        $pw = $pw . $sletters[$n2]; }
     elsif ($z == 2) {
        $pw = $pw . $numbers[$n3]; }
     elsif ($z == 3) {
        $pw = $pw . $special[$n4]; }
     else {
        print "There is bug";
        exit; }
     }
  print "The generated Password is: $pw \n";
}],

#_______________________________________________________________________
'whereami' => [
"whereami\t\tprint out the filelocation",
sub
{
  print __FILE__."\n";
}],

#_______________________________________________________________________
'get_country=s' => [
"get_country <ip>\t\tsingle-host 32bit decimal",
sub
{
  my $ip = shift;
  my $line=""; my $country=""; my $out="IP: $ip is non-registered";
  my $whois="http://www.utrace.de/whois/";
  my $hol=$whois.$ip;
  my $html=stuff($hol);
    $html =~ s/<([^>]|\n)*>//mig;
    $html =~ s/&nbsp;//mig;
    (my @text)=split(/\n/,$html);
        foreach $line (@text){
                      if( $line =~ /country:/ig ){
                      $line =~ s/\s//ig;
      (my $nix, $country)=split(/:/,$line);
                      $out="IP: $ip has country-code: $country";
                      goto ELMS;
          } # end if
         } # end foeach
  ELMS:
  print $out;
}],


#_______________________________________________________________________
'steuer2010=s' => [
"steuer2010 <einkommen>\t\tSteuer2010 - ESt und SolZ ",
sub
{
my $x=shift;

unless(defined($x))
{
  print "\n\nzu versteuerndes Einkommen: ";
  chomp ($x = <STDIN>);
}

my $est=0;my $soli=0;my $estsplit=0; my $solisplit=0;
if($x > 8004 && $x < 13470){$est=int((912.17*($x -8004)/10000+1400)*($x- 8004)/10000);}
if($x > 13469 && $x < 52882){$est=int((228.74*($x -13469)/10000+2397)*($x-13469)/10000+1038);}
if($x > 52881 && $x < 250731){$est=int($x*0.42-8172);}
if($x > 250730){$est=int($x*0.45-15694);}

my $xx=$x/2;
if($xx > 8004 && $xx < 13470){$estsplit=int((912.17*($xx -8004)/10000+1400)*($xx- 8004)/10000)*2;}
if($xx > 13469 && $xx < 52882){$estsplit=int((228.74*($xx -13469)/10000+2397)*($xx-13469)/10000+1038)*2;}
if($xx > 52881 && $xx < 250731){$estsplit=int($xx*0.42-8172)*2;}
if($xx > 250730){$estsplit=int($xx*0.45-15694)*2;}

if($est > 972){$soli=int($est*0.055);}
if($estsplit >1944){
     $solisplit=int($estsplit*0.055); my $test= int(($estsplit-1944)*0.2);
       if ($solisplit > $test){$solisplit=$test;}
  }
my $netto=$x-$est-$soli; my $nettosplit=$x-$estsplit-$solisplit;

print"\n             \t   - (ohne Kirche/Kind)  Steuer 2010 -    \n\n";
print"                         \tGrundtarif \t Splitting \n\n";
print"                    ESt: \t$est       \t $estsplit  \n\n";
print"     (* Vorbehalt) SolZ: \t$soli      \t $solisplit \n\n";
print"                  ----------------------------------------- \n";
print"                  Netto: \t$netto     \t $nettosplit \n";
print"\n\n * if(Verfassungsgericht_Urteil eq \"widerrechtlich\") {automatische Erstattung}\n\n";
}],


#_______________________________________________________________________
'xxo' => [
"xxo \t\t Game : TicTacToe",
sub
{
  print "What's your name Player1?: ";
  my $player1 = <STDIN>;
  chomp $player1;
  print "\nWhat's your name Player2?: ";
  my $player2 = <STDIN>;
  chomp $player2;

  if ($player1 eq $player2) {
    $player2 = $player2."2";
    }


  my @field = ("_", "_", "_", "_", "_", "_", "_", "_", "_", "_");
  my @valids = (1, 2, 3, 4, 5, 6, 7, 8, 9);
  my $name = $player1;
  my $roundcount = 1;
  my $choose;
  my $stone = 'x';
  my $win = 0;
  my $othername = $player2;
  my $tmpname;
  my $stone2 = 'o';
  my $tmpstone;
  my $valid; 

  system("clear");
  while ($roundcount <= 9 ) {

   
   print "|$field[7]|$field[8]|$field[9]|    |7|8|9|\n";
   print "|$field[4]|$field[5]|$field[6]|    |4|5|6|\n";
   print "|$field[1]|$field[2]|$field[3]|    |1|2|3|\n";
   print "\n$name your turn\n";
   print "In which field do you want to set? ";
   $choose = <STDIN>; 
   chomp $choose;
   
   if(grep $_ eq $choose, @valids) {
     $valid = 1; }
   else { 
     $valid = 0; } 

   if ($field[$choose] ne '_') {
     if ($field[$choose] eq $stone) {
	   print "you had set here before\n";
	   }
   else {
	   print "$othername had set here before\n";
	   }
	 $valid = 0;

	}
   else {
     $field[$choose] = $stone;
	 }
	
    if ($field[1] eq $stone and $field[2] eq $stone and $field[3] eq $stone) {
             $win = 1; }
    elsif ($field[4] eq $stone and $field[5] eq $stone and $field[6] eq $stone) {
             $win = 1; }
    elsif ($field[7] eq $stone and $field[8] eq $stone and $field[9] eq $stone) {
             $win = 1; }
    elsif ($field[1] eq $stone and $field[4] eq $stone and $field[7] eq $stone) {
             $win = 1; }
    elsif ($field[2] eq $stone and $field[5] eq $stone and $field[8] eq $stone) {
             $win = 1; }
    elsif ($field[3] eq $stone and $field[6] eq $stone and $field[9] eq $stone) {
             $win = 1; }
    elsif ($field[1] eq $stone and $field[5] eq $stone and $field[9] eq $stone) {
             $win = 1; }
    elsif ($field[3] eq $stone and $field[5] eq $stone and $field[7] eq $stone) {
             $win = 1; } 
			
	if ($win eq 1) {
      last;
    }
 	 
    $roundcount++;
			
	if ( $valid eq 1) {
	$tmpname = $name;
	$name = $othername;
	$othername = $tmpname;
	$tmpstone = $stone;
	$stone = $stone2;
	$stone2 = $tmpstone;
	system("clear");
	}
	else {
	  $roundcount--; }
	
  }
	
  print "|$field[7]|$field[8]|$field[9]|    |7|8|9|\n";
  print "|$field[4]|$field[5]|$field[6]|    |4|5|6|\n";
  print "|$field[1]|$field[2]|$field[3]|    |1|2|3|\n";
  if ($win eq 1) {
	print "Congratulations $name you win";
	}
  else {
	print "--->DRAW<---";
	}
}],
#_______________________________________________________________________
'timer=i' => [
"timer <time> \t\tlet Speaker beep after userdefined minutes",
sub {
  my $time = int(shift);
  my $timer = $time * 60;
  my $sleepy = $timer / 20;
  my $pro = 5;
  my $i = 1;
  init_progress;
  while ($i < 21) {
    update_progress $pro;
    $i += 1;
    $pro += 5;
    sleep($sleepy);
    }
  print "\n\a\a\a\a\a\a\a";
}],
#_______________________________________________________________________
'cat=s' => ["cat <file>\t\tprint file to STDOUT",

sub {
  my $file = shift;
  open(DATA, $file) or die "Can't open $file: $!\n";
  while (<DATA>)
  {
      print;
  }
  close(DATA);
  print "\n";
}],
#_______________________________________________________________________
'export=s,expdeparse:s' => [
"export <optionname> [--expdeparse '<B::Deparse Options>']\t\texport one option of this script (--expdeparse=1 force B::Deparse)",
sub {
  my $option=shift || '';
  my $depopts=shift || '';

  # normiere options_name
  $option=~s/^\-+//;
  $option=~s/=.*$//;
  $option=~s/\s.*$//;
  $option=~s/^\s+//;

  # finde hash_name zur Option
  my $name='';
  for my $key (keys(%commands))
  {
    if($key=~m!(?:^|,)\Q$option\E(?:=|:|,|$)!)
    {
      $name=$key;
      last;
    }
  }

  unless($name)
  {
    warn("NO valid Option: $option\n");
    HELP();
    return;
  }


  #hilfe holen
  my $help=$commands{$name}->[0];
  $help=~s/\t\t/\\n\\t/;

  # script lesen
  my $code_else='';
  {
    my $pos=tell(DATA);
    seek(DATA,0,0);
    local $/=undef;
    $code_else=<DATA>;
    seek(DATA,$pos,0);
  }

  my $code='';
  # code heraus schneiden
  if($depopts ne '')
  {
    $depopts='' if($depopts eq '1');
    my @opts=();
    @opts=split(/\s+/,$depopts) if($depopts);
    use B::Deparse;
    $code = B::Deparse->new(@opts)->coderef2text($commands{$name}->[1]);
  }
  else
  {
    ($code)=$code_else=~m#'\Q$name\E'\s*=>\s*\[\s*".+?"\s*,\s*sub\s*\{(.+?)\n\s*\}(?:\s*,[^\]]+)?\s*\]\s*,#s;
    $code="{\n$code\n}";
  }

  # Optionen umwandeln
  my @opt_list=split(/\s*,\s*/,$name);
  my @ref_list=();
  my $first=shift(@opt_list);
  if($first=~/=|:/)
  { $first='unshift(@opts,shift(@ARGV));'; }
  else
  { $first='unshift(@opts,1);'; }
  for(0..$#opt_list)
  {
    $opt_list[$_] =qq('$opt_list[$_]').' => \$opts['.$_.']';
    push(@ref_list,'undef');
  }
  push(@opt_list,q('help' => sub{ HELP(); }));

  # startcode erzeugen
  my $scode=sprintf(<<'EOC',join(', ',@ref_list),join(", ",@opt_list),$first,$option,$help,$option,$code);
my @opts=(%s);

my $ok=GetOptions(%s);

%s

HELP() if(@ARGV);
HELP() unless($ok);

%s(@opts);

########################################################################
# FUNCTIONS ############################################################
########################################################################

sub HELP
{
  print "usage: %s\n";
  exit(0);
}

sub %s
%s


EOC
  # history ändern
  my $time=localtime();
  $code_else=~s!# History:(?:\n#[^\n]+)*!# History:\n# AUTOEXPORT - $time - export of $option\n!;
  # code einfügen
  # von <-- please don't touch this
  # bis # FUNCTIONS #
  # wird alles gelöscht
  $code_else=~s!# <-- please don't touch this.+\n#+\n# FUNCTIONS #+\n#+\n!$scode!s;
  # unwichtige Funktionen entfernen
  $code_else=~s!#+\n# BUILD IN FUNCTIONS #+\n#+\n.+$!__END__!s;

  # alles in Datei schreiben
  open(my $fh, '>', "$option.pl") or die "ERROR open $option.pl ($!)";
  print $fh $code_else;
  close($fh);
}],

# <-- don't touch this

########################################################################
########################################################################
);

for(keys(%commands))
{
  my $opt=$_;
  my $cmdref=$commands{$_}[1];
  my $runn_mod='runn last';
  $runn_mod=lc($commands{$_}[2]) if(exists($commands{$_}[2]));
  my @olist=split(/\s*,\s*/s,$opt);

  if($runn_mod eq 'runn now')
  {
    for(@olist)
    { $opts{$_}=sub{ $cmdref->(pop(@_)); } }
  }
  elsif($runn_mod eq 'runn first')
  {
    for my $pos (0..$#olist)
    {
      die("no option in $opt position $pos\n") unless($olist[$pos]);
      $opts{$olist[$pos]}=sub{ add_cmd($opt,pop(@_),$pos,1); }
    }
  }
  elsif($runn_mod eq 'runn last')
  {
    for my $pos (0..$#olist)
    {
      die("no option in $opt position $pos\n") unless($olist[$pos]);
      $opts{$olist[$pos]}=sub{ add_cmd($opt,pop(@_),$pos,0); }
    }
  }
  else
  { die(qq#Can't interpret runn modifier "$runn_mod" \n#); }
}
my $ok=GetOptions(%opts);

HELP(@ARGV) if(@ARGV);
HELP(0) unless($ok);

for my $cmd (@runn)
{
  my $name=shift(@$cmd);
  $commands{$name}->[1]->(@$cmd);
}

########################################################################
# FUNCTIONS ############################################################
########################################################################

sub stuff {
  my $url=shift;
  my $agent="Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.9.0.18) EierlegendeMilchSau/1.0.0";
  my $cookie = HTTP::Cookies->new;

  my $req = HTTP::Request->new(GET => $url);
  $req->header('Referer', '');
  $req->header('Accept', 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8');
  $req->header('Accept-Language', 'de-de,de;q=0.8,en-us;q=0.5,en;q=0.3');
  $req->header('Accept-Charset', 'ISO-8859-1,utf-8;q=0.7,*;q=0.7');
  $req->header('Keep-Alive', '115');
  $req->header('Cache-Control', 'max-age=0');
  my $browser = LWP::UserAgent->new;
  $browser -> agent($agent);
  $browser -> cookie_jar($cookie);
  my $res = $browser->request($req);
  my $stuff = $res->content;
  return ($stuff);
}# end sub stuff

########################################################################
# BUILD IN FUNCTIONS ###################################################
########################################################################

sub add_cmd
{
  my $name=shift;
  my $opt=shift;
  my $pos=shift || 0;
  my $first=shift || 0;
  for my $ref (@runn)
  {
    if($ref->[0] eq  $name)
    {
      $ref->[$pos+1]=$opt;
      return;
    }
  }

  if($first)
  { unshift(@runn,[$name,$opt]); }
  else
  { push(@runn,[$name,$opt]); }
}

sub HELP{
  my @errors=@_;

  my @list=();
  my $length_first;
  my $length_second;
  for my $cmd (sort keys(%commands))
  {
    $length_first=length($cmd) if(!defined($length_first) || $length_first<length($cmd));
    my ($cmdtxt,$desctxt)=split("\t\t",$commands{$cmd}->[0],2);
    $desctxt='' unless($desctxt);
    $cmdtxt='' unless($cmdtxt);
    $length_second=length($cmdtxt) if(!defined($length_second) || $length_second<length($cmdtxt));
    push(@list,[$cmd,$cmdtxt,$desctxt]);
  }

  my $oh=\*STDOUT;
  $oh=\*STDERR if @errors;

  if($errors[0])
  {
    for(@errors)
    { print $oh "Unknown option: $_\n"; }
  }

  print $oh "usage: $0 <parameters>\n\n";
  print $oh "parameters:\n";

  for(@list)
  { printf $oh "  %-${length_first}s => --%-${length_second}s %s\n", @$_; }

  print $oh "\n";
  exit(@errors?1:0);
}

__END__