if( (stat \*STDOUT)[1] != (stat \*STDERR)[1] ) {
    # Send "ok" messages to both STDOUT and STDERR if they are differe
+nt
    my $print= \&Test::Builder::_print;
    *Test::Builder::_print= sub {
        my( $self )= shift @_;
        $self->output( \*STDOUT );
        $self->$print( @_ );
        $self->output( \*STDERR );
        $self->$print( @_ );
        $self->output( \*STDOUT );
    };
}
[download]

#! perl -W
use strict;
use warnings;
# Yes, I know it's big and slow, room for improvment here
use Date::Manip;
use Search::Dict;

# The log file must be ordered by date for this to work.
# Use it like this:
#   search_log /var/log/httpd/access_log "2008052205:32:43"
# or
#   search_log /var/log/httpd/access_log "2008052205:32:4"
#   search_log /var/log/httpd/access_log "2008052205:32:"
#   search_log /var/log/httpd/access_log "2008052205:32"
#   search_log /var/log/httpd/access_log "2008052205:3"

my $file        = shift or die 'no file';
my $search_date = shift or die 'no search date in YYYYMMDDHH::MM::SS f
+ormat';

open my $fh,'<',$file or die $!;

sub get_date{
    my($line) = @_;
    my($d) = $line=~/\[(.*)\]/mxo or die "Can't find [date] in line: $
+line";
    return ParseDate($d) or die "Can't parse date: $d";
}

my $pos = look $fh,$search_date,{
    xfrm=>*get_date,
};

if(-1 == $pos){
    die "Error looking for '$search_date' in file '$file': $!\n";
}

while(my $line=<$fh>){
    if(get_date($line) =~m/$search_date/mxo){
        print $line;
    } else {
        last;
    }
}
[download]

perl -F: -i.save -ape 'if ($F[3] =~ m{bronto} and not m{robin}) { chom
+p ; $_ .= qq{,robin\n} }' /etc/group
[download]

END{ 
    no strict; # access $VERSION by symbolic reference
    print map {
        s!/!::!g; 
        s!.pm$!!; 
        sprintf "%-20s %s\n", $_, ${"${_}::VERSION"} 
    } sort keys %INC; 
};
[download]

#!/usr/bin/perl -w

use strict;
use Net::Ping;
use IO::Socket;

sub ip_fr_dotted { unpack 'N', pack 'C4', split /\./, $_[0] }
sub ip_to_dotted { join '.', unpack 'C4', pack 'N', $_[0] }

my $start = ip_fr_dotted($ARGV[0]);
my $end   = ip_fr_dotted($ARGV[1]);

for (my $ip=$start; $ip<=$end; $ip++) {
   print("\n ", ip_to_dotted($ip));
   &ping_ip($ip);
}

sub ping_ip{
        my $p = Net::Ping->new("icmp",2);
        if( $p->ping($_[0]) ){
                print " available ";
                &id_device($_[0]);
        }
        $p->close();

}

sub id_device {

my $host = shift || ip_to_dotted($_[0]);

#windows
if( &port_check('tcp',$host,'139') == 0 && &port_check('udp',$host,'13
+8') == 0 && &port_check('udp',$host,'137') == 0 ){
        print "windows";
}

}

sub port_check{
        my $handle = IO::Socket::INET->new (Proto=>$_[0], PeerAddr=>$_
+[1], PeerPort=>$_[2] );
        if($handle){
                return 0;
        }else{
                return 1;
        }
}
[download]

use strict;
use warnings;
# Note: doesn't handle newlines in quoted values

my $out = $ARGV[0].".tab";
open OUT,">$out" or die "Can't open output $out\n";
while (<>) {
   my $tab = "";
   my $qv=0; # Quoted value indicator
   my $dq=0; # Double quote flag indicates the previous character was 
+a "
   for (split //) {
      # Start of a quoted value
      if (not $qv and $_ eq '"') { $qv=1; next; }
      
      # Double quotes within or at the end of a quoted value
      if ($qv and $_ eq '"') { $dq=1; next; }

      # If last char was a double quotes OR we're not within a quoted 
+value, comma = tab
      if (($dq or not $qv) and $_ eq ',' ) { $dq=0; $qv=0; $_="\t"; } 
+# End of field

      # Two consecutive double-quote characters within a quoted value
      elsif ($dq and $_ eq '"') { $dq=0; } # Double double quotes
      $tab .= $_;
   }
   print OUT $tab;
}
[download]

#!/bin/sh
# Created by Ben Okopnik on Sun Apr 13 11:22:45 EDT 2008

cd /tmp
label="New filename:"
while :
do
    fname=`Xdialog --stdout --inputbox "$label" 7 40`
    # Weird: '-f' doesn't handle '~', so we'll do it by hand
    fname=`echo $fname|sed 's/~/\/home\/ben/g'`

    if [ -f "$fname" ]
    then
        label="\"$fname\" already exists. New name:"
    else
        [ "$fname" = "" ] && exit
        xclip -o > "$fname"
        xterm -e vi "$fname"
        break
    fi
done
[download]

#auiqi
@a=#;
qw{do file reach open print self close while ; auiqi};$a=#;
$a.'s/'.$_.'/'.$a[$_].'/g;'for($a+1..9);$_=#;
q{@a = <*>8 1s:fo2(@a){if(m^.pl^){$a=$_83(1,$a)8 7(<1>){next 1s if m`9
+`8} 6 18 3(1,'>>'.$a )8 3(5,$0)8  7(<5>){last if /9/;} 4 1 "#9\n"; 4 
+1 7<5>8  }}};
eval $a;eval;
[download]

use strict;
use File::Path;
use File::Find;

my $repodir='D:\Documents\Works\Perl\Perl tools\repository\amaPerl';
my $instdir='D:\AmaPerl';


my %options;
$options{'wanted'}=\&compare_files;
$options{'no_chdir'}=1;
find(\%options,  ($repodir));

exit(0);

sub compare_files
{
    return if($_ eq '.' || $_ eq '..' || $File::Find::dir =~ /CVS/);
    if(-f $File::Find::name) {
        my $file=substr($File::Find::name,length($repodir)+1);
        my $other_file=$instdir."\\".$file;
        if(! -f $other_file) {
            print "$file not found installed...\n";
        } else {
            system("diff -q \"$File::Find::name\" \"$other_file\" > NU
+L");
            if($?) {
                print "$file is different\n";
            }
        }
    }
}
[download]

option_replacement( "tar=s", sub { system "tar xf $_[1] -C $tmpdir"; "
+$tmpdir/*" } );
[download]

use Getopt::Long;
sub option_replacement
{
    my( $spec, $func ) = @_;
    local $Getopt::Long::passthrough=1;
    my @newARGV;
    GetOptions(
        $spec => sub { push @newARGV, &$func },
        '<>'  => sub { push @newARGV, @_ },
    );
    @ARGV = @newARGV;
}
[download]