Code is porn

sub CreateLST {
 my ($tpl_file,$output)=@_; my $spl;
 my $tpl = uc(tacoenf::load_as_string($tpl_file));
 $tpl =~ s/\%pause(.*)\%/&pause($1,$sn)/gie;
 $tpl =~ s/\%(.*)\%/"-1\t".$file{uc($1)}/gie;
 $tpl = &removeblank($tpl);
 my $ntpl = @ntpl = split(/\n/,$tpl); 
 my $str = $ntpl."\n".$tpl."\n";
 tacoenf::save_file($output,$str,0);
 if ($debug) {
  print $tpl_file." -> ".$output."\n";
  print "-"x60; print "\n";
  print $str;
  print "-"x60; print "\n\n";
 }
 
}

sub CreateSEQ {
 my ($tpl_file,$output)=@_; my $sn=0; my $str;
 my @ntpl = tacoenf::load_as_array($tpl_file);
 foreach $tpl(@ntpl) {
   $tpl =~ s/\%time\%/"file$sn=.time\nlength$n=-1\n"/gie;
   $tpl =~ s/\%pause(.*)\%/&seqpause($1,$sn)/gie;
   $tpl =~ s/\%(.*)\%/"file$sn=".$file{uc($1)}."\nlength$n=-1\n"/gie;
   $str .=$tpl; $sn++;
 }
 
 $str = &removeblank(&removeblank($str));
 
 $strn = "\n[playlist]\n\n".$str."\nNumberofentries=".$sn."\nnextindex=0\n";

 tacoenf::save_file($output,$strn,0);
 if ($debug) {
  print $tpl_file." -> ".$output."\n";
  print "-"x60; print "\n";
  print $strn;
  print "-"x60; print "\n\n";
 }
}

sub removeblank {
 my $str = shift;
 $str =~ s/-1\t\n/\n/gi;
 $str =~ s/\n\n/\n/gi;
 $str =~ s/^[\s]//gi; 
 $str =~ s/[\s]$//gi; 
 return $str;
}

sub seqpause {
 my ($p,$n) = @_; my $pa = $p*1000;
 return "file$n=$p.pause\nlength=$pa\n";
}

sub pause {
 my $p = shift; my $pa = $p*1000;
 return "$pa\t$p.pause";
}

Label: perl, zararadio

sub IniLoad {
 # my %ini = &IniLoad("/where/is/file.ini");
 # print $ini{"section:field"};
 my $file=shift; my %ini; my @INI = &tacoenf::load_as_array($file);
 for $l(@INI) {
  $l=tacoenf::notrail($l);
  if ($l=~/^\[(.*)\]/) {
   $vsection = $l; $vsection =~ s/^\[(.*)\]$/$1/ie;
  }
  next if ($l eq "");
  next if ($l=~/^\[(.*)\]/);
  my $value=$vkey=$l;
  $vkey =~ s/(.*)\=(.*)/$1/gie; $vkey=tacoenf::trim($vkey);
  $value=~ s/(.*)\=(.*)/$2/gie; $value=tacoenf::trim($value);
  $ini{"$vsection:$vkey"} = $value;
 }
 return %ini

}

#A Shortcut
sub IniRead {
 my($file,$section,$key)=@_;
 my %ini = &IniLoad("where/is/file.ini");
 return $ini{"$section:$key"};
}

require tacoen.pm

Label: ini, perl

Perl script using shell command to get(/grep) the lastest file on directory for download. Just Create .htaccess (DirectoryIndex .latest.cgi) for more automations, so to get the latest files, just point your download link to: "yoursite.com/files/"

#!/usr/bin/perl
#This is .latest.cgi
$|++; my @file = `ls -1 -t -p | grep -v -P '/'`; 
print "Location: $file[0]\n\n";
exit;

Label: bash, files, perl

#!/usr/bin/perl
#This is .latest.cgi
$|++; my @file = `ls -1 -t -p | grep -v -P '/'`; 
print "Location: $file[0]\n\n";
exit;

Label: files, perl

#!/usr/bin/perl

# require common rutins.

my $USER = $ARGV[0]; my $DOMAIN = $ARGV[1]; &error(1) if (!$USER || !$DOMAIN);

$thepath = "/var/www/$USER";

system "useradd $USER -d $thepath -s /bin/bash";
system "mkdir $thepath" if (!-e $thepath);
system "mkdir $thepath/.log";
system "mkdir $thepath/.tmp";

$vhostconf = &load_as_string("/yourpath/vhost-prop/vhost.txt");
$vhostconf =~ s/\%DOMAIN\%/$DOMAIN/gi;
$vhostconf =~ s/\%USER\%/$USER/gi;
&save_file("/yourpath/vhost.d/$USER.conf",$vhostconf,0);

$logrotate = &load_as_string("/yourpath/vhost-prop/log.txt");
$logrotate =~ s/\%USER\%/$USER/gi;
&save_file("/etc/logrotate.d/httpd-$USER",$logrotate,0);

$phpini = &load_as_string("/yourpath/vhost-prop/php.ini.txt");
$phpini =~ s/\%USER\%/$USER/gi;
&save_file("$thepath/php.ini",$phpini,0);

system "cp -f /yourpath/vhost-prop/favicon.ico $thepath";
system "cp -f /yourpath/vhost-prop/robots.txt $thepath";
system "chmod 755 $thepath";
system "touch $thepath/.log/access.log";
system "touch $thepath/.log/error.log";
system "chmod 755 $thepath/.log";
system "chmod 755 $thepath/.tmp";
system "chown $USER:$USER $thepath -R";

#$newrec  = "$USER CNAME farm\n";
#$dnshead = &load_as_string("/yourpath/vhost-prop/in-dns.txt")."\n".$newrec;
#$serial = &serialize();
#$dnshead =~ s/\%SERIAL\%/$serial/gi;

#&save_file("/yourpath/vhost-prop/in-dns.txt",$newrec,1);
#&save_file("/var/named/yourdomains.dns",$dnshead);

#system "rndc reload yourdomains.net";

system "passwd $USER";

exit;

sub error { my $e = shift;
print "syntax: $ARGV[0] [user] [domain]\n" if ($e == 1);
exit;
}

template vhost dan dns tidak ada disini.

Label: apache, linux, perl

Beberapa fungsi yg sering dipakai untuk mengolah text file, tapi sering banget terlupakan sama saya, jadi ditaruh disini. kalau perlu saya tinggal cnp.

sub pathdir {
        my $d=$_[0]; my (@d,@dir);
        opendir (D, $d); @d=grep(!/^\./, readdir(D)); close (D);
        foreach (@d) { push (@dir,&strip($_)) if (-d "$d/$_") }
        return @dir;
}

sub filedir {
        my $e=$_[1]."\$"; $e=~ s/\,/\$\|/g; my $d=$_[0];
        my (@d,@dir); opendir (D, $d); @d=grep(!/^\./, readdir(D)); close (D);
        foreach (grep(/$e/, @d)) { push (@dir,&strip($_)) if (-f "$d/$_") }
        return @dir;
}

sub load_as_string {
        my ($f,$k) = @_; my @R; my $t; return if (! -e $f && ! -f $f);
        open (F,"$f"); flock F, 2 if ($k eq 1); @R = ; close (F); flock F, 8 if ($k eq 1);
        $t =join("",@R); ~ s/\r//gi; return $t;
}

sub load_as_array {
        my ($f,$k) = @_; my @R; return if (! -e $f && ! -f $f);
        open (F,"$f"); flock F, 2 if ($k eq 1); @R = ; close (F); flock F, 8 if ($k eq 1);
        return @R
}

sub save_file {
        my ($rf,$rtext,$md,$k) = @_; if ($md eq 1) { $md=">>" } else { $md=">" }
        open (F, "$md$rf"); if ($k eq 1) {flock F, 2}
        print F $rtext; close (F); if ($k eq 1) {flock F, 8}
}

sub safestr {
        my $str=shift; $str=~ s/^\$.*//g; $str=~ s/^#.*//g;
        $str=~ s/^\s*//g; $str=~ s/\s*$//g;
        $str=~ s/\s*\s/ /g;$str=~ s/==\s/==/g; $str=~ s/\s==/==/g;
        $str=~ s/\n//g; $str=~ s/\r//g; $str =~ s/\t//g;
        return $str;
}

sub slash { my $str=shift; $str =~ s/\/\//\//gi; return $str }
sub strip { my $str=shift; $str =~ s/\n//gi; $str =~ s/\r//gi; return $str }
sub rstrip { my $str=shift; chop($str) if ($str=~ /\r$/); return $str }
sub htmlize { print "Content-type: text/html\n\n"; }
sub htmlize_nocache { print "Pragma: no-cache\nContent-type: text/html\n\n"; }
sub get_input {
        my $nossi = shift; my ($b,$p);
        if ($ENV{'QUERY_STRING'}) { $b = $ENV{'QUERY_STRING'}; }
        elsif ($ENV{REQUEST_METHOD} eq "POST") { read(STDIN, $b, $ENV{'CONTENT_LENGTH'});}
        if ($b) {
        foreach $p(split(/&/, $b)) {
                ($name, $value) = split(/=/, $p);
                $name =~ tr/+/ /; $value =~ tr/+/ /;
                $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
                $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
                $value =~ s///g if ($INPUT{$name});
                if ($INPUT{$name}) { $INPUT{$name} = "$INPUT{$name},$value";}
                else { $INPUT{$name} = $value;}
        }
        return %INPUT;
        }
}

sub get_filesize {
        my $size=0; if (-e $file) { $size= (stat($_))[7] }
        return $size;
}# end of get_filesize

sub serialize {
    my $time = shift; $time or ($time = time);
    my @months = qw!Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec!;

    my ($min, $hr, $day, $mon, $yr) = (localtime($time))[1,2,3,4,5];
    $tmon = $mon+1;
    $yr = $yr + 1900;
    ($min < 10) and ($min = "0$min");
    ($hr  < 10) and ($hr  = "0$hr");
    ($day < 10) and ($day = "0$day");
    ($tmon < 10) and ($tmon = "0$tmon");

    return "$yr$tmon$day";
}

tacoen.pm

Di-package jadi tacoenf

package tacoenf;

sub winpath { my $path = shift; $path =~ s/\\/\//gi; return $path; }
sub pathwin { my $path = shift; $path =~ s/\//\\/gi; return $path; }
sub slash { my $str=shift; $str =~ s/\/\//\//gi; return $str }
sub strip { my $str=shift; $str =~ s/\n//gi; $str =~ s/\r//gi; return $str }
sub rstrip { my $str=shift; chop($str) if ($str=~ /\r$/); return $str }
sub htmlize { print "Content-type: text/html\n\n"; }
sub trim { my $s = shift; $s=~ s/\s+$//gi; $s=~ s/^\s+//gi; return $s; }
sub notrail { my $l = shift; chomp($l) if ($l=~ /\n$/); chomp($l) if ($l=~ /\r$/); $l=~ s/\s+/ /go; return $l }

sub safestr {
 my $str=shift; $str=~ s/^\$.*//g; $str=~ s/^#.*//g;
 $str=~ s/^\s*//g; $str=~ s/\s*$//g;
 $str=~ s/\s*\s/ /g;$str=~ s/==\s/==/g; $str=~ s/\s==/==/g;
 $str=~ s/\n//g; $str=~ s/\r//g; $str =~ s/\t//g;
 return $str;
}

sub pathdir {
 my $d=$_[0]; my (@d,@dir);
 opendir (D, $d); @d=grep(!/^\./, readdir(D)); close (D);
 foreach (@d) { push (@dir,&strip($_)) if (-d "$d/$_") }
 return @dir;
}

sub filedir {
 my $e=$_[1]."\$"; $e=~ s/\,/\$\|/g; my $d=$_[0];
 my (@d,@dir); opendir (D, $d); @d=grep(!/^\./, readdir(D)); close (D);
 foreach (grep(/$e/, @d)) { push (@dir,&strip($_)) if (-f "$d/$_") }
 return @dir;
}

sub load_as_string {
 my ($f,$k) = @_; my @R; my $t; return if (! -e $f && ! -f $f);
 open (F,"$f"); flock F, 2 if ($k eq 1); @R = ; close (F); flock F, 8 if ($k eq 1);
 $t =join("",@R); ~ s/\r//gi; return $t;
}


sub load_as_array {
 my ($f,$k) = @_; my @R; return if (! -e $f && ! -f $f);
 open (F,"$f"); flock F, 2 if ($k eq 1); @R = ; close (F); flock F, 8 if ($k eq 1);
 return @R
}

sub save_file {
 my ($rf,$rtext,$md,$k) = @_; if ($md eq 1) { $md=">>" } else { $md=">" }
 open (F, "$md$rf"); if ($k eq 1) {flock F, 2}
 print F $rtext; close (F); if ($k eq 1) {flock F, 8}
}

sub scopy {
 my ($src,$dst) = @_;
 if (-e $src) {
  open(FILE,"$src"); flock(FILE,2) if $operatingsystem eq "unix";
  @filedata = ; chomp @filedata;
  close(FILE);
  open(FILE,">$dst");
  foreach $_ (@filedata) { print FILE "$_\n"; }
  close(FILE);
 }
}


sub serialize {
 my $time = shift; $time or ($time = time);
 my @months = qw!Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec!;
 my ($sec,$min, $hr, $day, $mon, $yr) = (localtime($time))[0,1,2,3,4,5];
 $tmon = $mon+1;
 $yr = $yr + 1900;
 ($sec < 10)  and ($sec  = "0$sec");
 ($min < 10)  and ($min  = "0$min");
 ($hr < 10)   and ($hr   = "0$hr");
 ($day < 10)  and ($day  = "0$day");
 ($tmon < 10) and ($tmon = "0$tmon");
 return "$yr$tmon$day$hr$min$sec";
}

sub IniRead {
 my($file,$section,$key)=@_;
 my %ini = &IniLoad("v:\\claudio-b\\conf\\claudio.ini");
 return $ini{"$section:$key"};
}

sub IniLoad {
 # my %ini = &IniLoad("v:\\claudio-b\\conf\\claudio.ini");
 # print $ini{"path:autocue"};
 my $file=shift; my %ini; my @INI = &tacoenf::load_as_array($file);
 for $l(@INI) {
  $l=tacoenf::notrail($l);
  if ($l=~/^\[(.*)\]/) {
   $vsection = $l; $vsection =~ s/^\[(.*)\]$/$1/ie;
  }
  next if ($l eq "");
  next if ($l=~/^\[(.*)\]/);
  my $value=$vkey=$l;
  $vkey =~ s/(.*)\=(.*)/$1/gie; $vkey=tacoenf::trim($vkey);
  $value=~ s/(.*)\=(.*)/$2/gie; $value=tacoenf::trim($value);
  $ini{"$vsection:$vkey"} = $value;
 }
 return %ini

}

sub unix2dos   { my $f = shift; $f =~ s#/#\\#gi; return $f; } 
sub compatible { my $f = shift; $f =~ s#\\#/#gi; return $f; } 

1;

Label: common, perl

#!/usr/bin/perl
$|=1;

while (<>) {

    @X = split; $url = $X[0]; $url =~s/[\n|\r]//gi; $gurl = $url;

    # kecuali address mu
 
    if (
        ($gurl =~ /^http\:\/\/what\.youraddress\.net/) ||
        ($gurl =~ /^http\:\/\/192\.168\.192\.254/) ||
        ($gurl =~ /^http\:\/\/other\.youraddress\.net/)
    ){
        print "$gurl\n";
    } else {
        print "http://youraddress.net/togo\n";
    }

}

exit;

---

In squid.conf put/add

url_rewrite_program /yourpath/this-redirect-script
url_rewrite_children 12

Label: perl, squid

#!/usr/bin/perl
#
# untuk membersihkan file yang diakses terakhir $hari
# di directory $path
#
my $hari = 49;
my $path = $ARGV[1];
my $query = $ARGV[0];
if ((!$query) && (!$path)) { print "Sytanx: rdelete [pattern] [path]\n"; exit }

&destroy(`find $path -iname $query`);

sub destroy {
    my @filelist = @_;
    foreach $file(@filelist) {
        chomp($file);
        print "$file\n";
        unlink "$file";
    }
}

reset;
exit;

Label: files, perl