Code is porn

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