#!/usr/bin/perl -w
use strict;

# Script to send email reminders in a cron job.
# Email trac at revragnarok <.> com

# I should've made it DBI compliant - but I'm not getting paid for this ;)

BEGIN {
   push @INC, "/usr/src/my_scripts/mail_reminder"; # Where ADMMailHandler is hiding
}

use Data::Dumper;
use ADMMailHandler;
use DirHandle;

use constant URLbeforeproj => 'http://webmail.revragnarok.com/';
use constant URLafterproj => '/ticket/';
use constant Nodomain => '@yourdomain.com';
use constant Subject => 'Outstanding tickets';

chdir("/var/www/trac");

my (%proj, %user);
my @projs;
# Look in directory for project names
my $dh = DirHandle->new('.') or die "Can't open trac directory! : $!\n";
while (defined ($_ = $dh->read)) {
  # Does it have a trac DB?
  if (-e "$_/db/trac.db") {
    push @projs, $_;
  } # -e
}
foreach my $projname (@projs) {
  # Open each one
  open(SQL,"/usr/bin/sqlite3 $projname/db/trac.db \"select id,status,owner,summary from ticket where status != 'closed'\"|");
  while (<SQL>) {
    chomp;
    my ($id, $status, $owner, $summary) = split /\|/;
    #print "Proj: $projname, ID: '$id', status: '$status', owner: '$owner', summary: '$summary'\n";
    next if ($owner eq '');
    $user{$owner}{"$projname-$id"} = $summary;
  }
  close(SQL);
}
foreach my $username (sort keys %user) {
  # Verify it is valid
  my $fullname = $username;
  $fullname.= Nodomain if ($fullname !~ /@/);
  # Put together the email
  my $mh = ADMMailHandler::new($fullname, 1, Subject);
  $mh->append(qq{<TABLE WIDTH=95% BORDER=1><TR>
<TD><B><U>Project</U></B></TD>
<TD><B><U>Ticket Summary</U></B></TD></TR>});
  foreach my $ticket (sort keys %{$user{$username}}) {
    my ($proj, $num) = split(/-/, $ticket);
    # print "Processing (proj = $proj) (num = $num) (summary = $user{$username}{$ticket})\n";
    $mh->append(qq{<TR><TD>$proj #$num</TD><TD><A HREF="}.URLbeforeproj.$proj.URLafterproj.$num.qq{">}.$user{$username}{$ticket}."</A></TD></TR>\n");
  }
  $mh->append("</TABLE>");
  $mh->sendit();
  # Now we'll make a special 'MyTickets' wiki page if the person has their own sandbox
  my ($tryname, undef) = split(/@/, $fullname);
  if (scalar grep(/^${tryname}$/, @projs)) {
    # There is a match
    open(WIKI, ">/tmp/$$");
    print WIKI "== My Tickets ==\n||'''__Project__'''||'''__Ticket Summary__'''||\n";
    foreach my $ticket (sort keys %{$user{$username}}) {
      my ($proj, $num) = split(/-/, $ticket);
      print WIKI "||$proj !#$num||[$proj:ticket:$num $user{$username}{$ticket}]||\n";
    }
    close WIKI;
    `/usr/bin/trac-admin $tryname wiki remove MyTickets > /dev/null 2>/dev/null`;
    `/usr/bin/trac-admin $tryname wiki import MyTickets /tmp/$$`;
    unlink "/tmp/$$";
  } # Sandbox or not
} # Each username

#!/usr/bin/perl -w
# This program splits incoming data into ~1GB chunks (for dumping a file
# on the fly to FAT32 partitions for example).
# Data is STDIN, and first argument is prefix of output (optional).
#
# To recombine the output, simply:
# cat FILE_* > /path/to/better/fs/OriginalFile

BEGIN {
push(@INC, "/mnt/hd/usr/lib/perl5/5.8.8/");
push(@INC, "/mnt/hd/usr/lib/perl5/5.8.8/i386-linux-thread-multi/");
}
use strict;
use Fcntl; # import sysread flags

binmode(STDIN);

use constant FULL_SIZE => (2*1024*1024*1024); # 2 GB

my $chunk_byte_count = FULL_SIZE+1; # Force an open on first output byte
my $chunk_file_count = 0; # Start at file 0
my ($read_count, $buffer);
my $blksize = 1024; # This might get overwritten later
my $prefix = $ARGV[0] || "FILE";

# The framework of this is from camel page 231

while ($read_count = sysread STDIN, $buffer, $blksize) {
  if (!defined $read_count) {
    next if $! =~ /^Interrupted/;
    die "System read error: $!\n";
  }
  # Decide if we need another file
  if ($chunk_byte_count >= FULL_SIZE) { # Need a new file
    close OUTFILE if $chunk_file_count;
    sysopen OUTFILE, (sprintf "${prefix}_%02d", $chunk_file_count++),
      O_WRONLY | O_TRUNC | O_CREAT | O_BINARY or die "Could not open output file for write!\n";
    $blksize = (stat OUTFILE)[11] || 16384; # Get preferred block size
    # print STDERR "(New output file from $0 (blksize $blksize))\n";
    $chunk_byte_count = 0;
  } # New file
  my $wr_ptr = 0; # Pointer within buffer
  while ($read_count) { # This handles partial writes
    my $written = syswrite OUTFILE, $buffer, $read_count, $wr_ptr;
    die "System write error: $!\n" unless defined $written;
    $read_count -= $written;
    $wr_ptr += $written;
  } # Writing a chunk
  $chunk_byte_count += $wr_ptr;
  #print "(\$wr_ptr = $wr_ptr), (\$chunk_byte_count = $chunk_byte_count), (\$chunk_file_count = $chunk_file_count)\n";
} # Main read loop

# Report on it
print "Wrote out $chunk_file_count chunk files.\n";

#!/usr/bin/perl -w
# This program fills a hard drive with 2GB files all NULL.
# (This makes compressed images of the hard drive smaller.)
# First argument is prefix of output (optional).
#

BEGIN {
  push(@INC, "/mnt/hd/usr/lib/perl5/5.8.8/");
  push(@INC, "/mnt/hd/usr/lib/perl5/5.8.8/i386-linux-thread-multi/");
}

use strict;
use Fcntl qw(:DEFAULT :seek); # import sysread flags

use constant FULL_SIZE => 2*(1024*1024*1024); # 2 GB

my $chunk_byte_count = FULL_SIZE+1; # Force an open on first output byte
my $chunk_file_count = 0; # Start at file 0
my ($read_count, $buffer);
my $blksize = 16384; # This might get overwritten later
my $prefix = $ARGV[0] || "FILL";
my $last_show = -1;
$| = 1; # always flush

# The framework of this is from camel page 231
$buffer = "\0" x $blksize;

# Without pre-alloc:
#real    1m20.860s
#user    0m10.155s
#sys     0m32.531s

# With pre-alloc:
#real    8m56.391s
#user    0m16.359s
#sys     1m11.921s

# Which makes NO sense, but hey, that's Cygwin... maybe because FAT32?

# Note: It was O_RDWR but switching to O_WRONLY didn't seem to help.
# However, maybe if Norton is disabled?

while (1) {
  # Decide if we need another file
  if ($chunk_byte_count >= FULL_SIZE) { # Need a new file
    close OUTFILE if $chunk_file_count;
    print STDERR "\rNew fill output file ($prefix)... \n";
    sysopen OUTFILE, (sprintf "${prefix}_%02d", $chunk_file_count++),
      O_WRONLY | O_TRUNC | O_CREAT | O_BINARY | O_EXCL or die "Could not open output file for write!\n";
    # Pre-allocate the file
#    print STDERR "New fill output file ($prefix) pre-allocating, expect freeze... \n";
#    sysseek OUTFILE, FULL_SIZE-1, SEEK_SET;
#    syswrite OUTFILE, $buffer, 1, 0;
#    close OUTFILE;
#    print STDERR "\tdone, now blanking out the file.\n";
#    sysopen OUTFILE, (sprintf "${prefix}_%02d", $chunk_file_count++),
#      O_WRONLY | O_BINARY or die "Could not re-open output file for write!\n";
#    sysseek OUTFILE, 0, SEEK_SET; # This might just be ignored?
    # Done pre-allocating
    my $blk = $blksize;
    $blksize = (stat OUTFILE)[11] || 16384; # Get preferred block size
    if ($blksize != $blk) {
      # new block size, should only happen once
      $buffer = "\0"x$blksize;
    }
    $chunk_byte_count = 0;
    $last_show = -1;
  } # New file
  $read_count = $blksize;
  while ($read_count) { # This handles partial writes
    my $written = syswrite OUTFILE, $buffer, $read_count, 0;
    die "System write error: $!\n" unless defined $written;
    $read_count -= $written;
    $chunk_byte_count += $written;
  } # Writing a chunk
  # End of a chunk
  my $new_show = int ($chunk_byte_count/(1024*1024));
  if ($new_show > $last_show) {
    print STDERR "\r${new_show}MB";
    $last_show = $new_show;
  }
#  print "(\$chunk_byte_count = $chunk_byte_count), (\$chunk_file_count = $chunk_file_count)\n";
} # Main while loop

# Report on it [think it always crashes before this ;)]
print "\rWrote out $chunk_file_count chunk files.\n";

#!/usr/bin/perl -w

# This was written by RevRagnarok (I'm on Wikipedia)
# I was having problems with all the split files on a FAT32 partition. I assume
# it is because there were so many plus two entries for each (LFNs).
# This simply combines all the rec* files again into large chunks of N where
# I used 5, but you can set below with $combine.
# Verification info below.
# Lastly, I needed to modify the Makefile and remove the "split" from the
# "wikipedia" target.

use strict;

# Using: rec13778enwiki-20070802-pages-articles.xml.bz2
my $last = 13778;
my $lastd = 5; # How many digits in above (yes, I can compute this, but why?)
my $date = 20070802;
my $suffix = "enwiki-${date}-pages-articles.xml.bz2";
my $combine = 5; # This will combine every 5 into a group
                 # (If this number makes > 4 digit results, it will not sort nicely)
my $outputdir = '/data/wikipedia/'; # Don't make it the same place...

my $joinstr = '';
my $fcount = 0;

for (1 .. $last) {
  my $num = sprintf "%0${lastd}d", $_;
  $joinstr .= "rec${num}${suffix} ";
  if (($_ % $combine) == 0) {
      &catthem($joinstr, $fcount++);
      $joinstr = '';
  }
}

&catthem($joinstr, $fcount++) if ($joinstr ne '');
print "All done!\n";

sub catthem ($$) {
  my $ofile = sprintf "rec%04d.bz2", $_[1];
  `/bin/cat $_[0] >${outputdir}${ofile}`; # Lazy again, there are more Perl-ish ways.
  print ".";
}

__DATA__

To make sure they were all taken in, you can do this:
bash$ bzip2 -tvv *bz2 2>&1 | grep -v ok | grep -v bz2 | wc -l
13778

...which is equal to the number of start blocks, so I know nothing is missing now.

#!/usr/bin/perl
my $COUNT = 8; #Orders of magnitude
my $HIT = 0;

for(my $i = 1; $i < 10**$COUNT; ++$i){
        $HIT++ if rand()**2 + rand()**2 <= 1;
        printf "PI ~ %1.8f after %0${COUNT}i points\n", 4*$HIT/$i, $i if
               ($i % 1_000) == 0;
}

#!/usr/bin/perl -w
use Date::Parse;
while (<>) {
        if ($_ !~ /insert into/i) {
                print;
                next;
        }
        if (m|(\d{4}/\d{1,2}/\d{1,2})/|ios) {
                print STDERR "Found date of $1: ";
                my $time1 = str2time($1);
                print STDERR $time1, "\n";
                # Now replace the current timestamp with a newone.
                my $str = $_;
                $str =~ s/\d{10}\.?\d{0,2}/$time1/;
                print $str;
        } else {
                # Standard wiki page (non-blog)
                print;
        }
}

<VirtualHost *>
  ServerName svn.whatever
  ServerAlias svn
  <Perl>
#!/usr/bin/perl
my $svn_path = "/var/svn";
my $svn_location = "";
my $trac_path = "/var/trac";
opendir(SVN_ROOT, $svn_path) or die "Cannot open $svn_path";

while (my $name = readdir(SVN_ROOT)) {
  if ($name =~ /^[[:alnum:]]+$/) {
    $Location{"$svn_location/$name"} = {
      DAV => "svn",
      SVNPath => "$svn_path/$name",
      AuthType => "Basic",
      AuthName => "\"Subversion login\"",
      AuthUserFile => "$trac_path/access.user",
      AuthGroupFile => "$trac_path/access.group",
      Require => "group $name",
    };
  }
}

closedir(SVN_ROOT);

__END__

  </Perl>
</VirtualHost>

#!/usr/bin/perl -w
use Data::Dumper;
my $textdump;
my %lhash;
my %rhash;
my $debug = 0;
my $file = $ARGV[0];
# Some filenames have () in them that we need to escape:
$file =~ s/\(/\\(/g;
$file =~ s/\)/\\)/g;

open (INPUT, "diff -iEbwBrsty --suppress-common-lines Projects/$file Folder\\ for\\ Experimenting/Projects/$file|");
while (<INPUT>) {
        if ($_ =~ /Files .*differ$/) {
                #Binary files
                print "Binary file comparison - they differ.\n";
                exit;
        }
        if ($_ =~ /Files .*identical$/) {
                print "No diff!\n";
                exit;
        }
        my $a = 0;
        # For some reason chomp was giving me problems (cygwin, win2k)
        s/\n//g;
        s/\r//g;
        $_ =~ /^(.*)([<>\|])(.*)$/;
        my $left = $1;
        my $dir = $2;
        my $right = $3;
        $left =~ /^\s*(.*?)\s*$/;
        $left = $1;
        $right =~ /^\s*(.*?)\s*$/;
        $right = $1;
#       print "1: '$left'\n2: '$dir'\n3: '$right'\n";
        # OK, now we have all we wanted...
        if ($dir eq '<') {
                $lhash{$left}++;
                $a++;
        };
        if ($dir eq '>') {
                $rhash{$right}++;
                $a++;
        }
        if ($dir eq '|') {
                $lhash{$left}++;
                $rhash{$right}++;
                $a++;
        }
        print "Missed this: $left $dir $right\n" unless $a;
} # while

close(INPUT);
foreach (sort keys %lhash) {
        if (not exists $rhash{$_}) {
                # No Match...
                print "Only in left: '$_'\n";
        } else {
                if ($lhash{$_} != $rhash{$_}) {
                        print "Left count not equal to Right, $_\n";
                }
        }
}

foreach (sort keys %rhash) {
        if (not exists $lhash{$_}) {
                # No Match...
                print "Only in right: '$_'\n";
        } else {
                if ($lhash{$_} != $rhash{$_}) {
                        print "Left count not equal to Right, $_\n";
                }
        }
}

print Dumper(\%rhash) if $debug;
print Dumper(\%lhash) if $debug;

#!/usr/bin/perl

open OUTFILE, ">smtproutes";

$s = ":smtp.comcast.net\n"; # Replace with your ISP's outbound server

foreach (<DATA>) {
chomp;
next if /^\w*$/;
next if /#/;
print OUTFILE "$_$s.$_$s";
}

__DATA__
aol.com
pipeline.com
earthlink.net
comcast.net
ix.netcom.com
netcom.com
hut.fi
t-3.cc
earthengineering.com
usa.com
#CS is old compuserv, now AOL
cs.com
stanfordalumni.org
erasableinc.org
sbcglobal.net
hp.com
abs.net
juno.com
sourcenw.com
yahoogroups.com
msn.com