#!/usr/bin/perl -w 
# tester.pl - test perl constructs
# author : dave w capella   http://grox.net/mailme
# date     : Wed Feb 13 10:29:38 PST 2008
############################################################
use strict;
use Socket;          # for inet_ntoa()

my $verylongbogusname = q(

#!/usr/bin/perl
#
############################################################
# delimit mac/ipv6 address with colons
#
sub colonize {
	my ($s) = @_;
	my $l = int(length($s) / 2) + length($s) % 2;
	return join(":", unpack("A2" x $l, $s) );
}

sub testcolonize {
	my ($s) = @_;
	my $c = colonize($s);
	print <<EOM;
s: $s
c: $c

EOM
}

testcolonize("00301928ff00");
testcolonize("00301928ff001");
testcolonize("00301928ff0020");

############################################################
# eof: colonize        vim: set ts=4 sts=4 sw=4 tw=0 noet

############################################################
# sqlite example
# requires DBD::SQLite from cpan
#
#use DBI;
#my $dbfile = "/home/dave/test.db";
#my $db = DBI->connect("dbi:SQLite:$dbfile", "", "",
#{RaiseError => 1, AutoCommit => 1});
#
#$db->do("CREATE TABLE n (id INTEGER PRIMARY KEY, f TEXT, l TEXT)");
#$db->do("INSERT INTO n VALUES (NULL, 'john', 'smith')");
#my $all = $db->selectall_arrayref("SELECT * FROM n");
#
#foreach my $row (@$all) {
#my ($id, $first, $last) = @$row;
#print "$id|$first|$last\n";
#}
#unlink($dbfile);

############################################################
# chop - the hard way
#my $str = "1,2,3,";
#$str =~ s/,$//;
#print $str, "\n";          # prints "1,2,3"

############################################################
# test for a substring
#
#our $str = "he:lo";
#print "yes \n" if $str =~ /:/;    # prints "yes"
##
## yea, you can use a single string as an array. (but why?)
## this prints "he:lo"
##
#my @macs = ($str);
#for my $foostr (@macs) { print $foostr . "\n"; }

############################################################
# print the program's arguments
# call as "program arg1 arg2"
# prints:
# arg1
# arg2
# 
foreach my $s (@ARGV) {
	print $s, "\n";
}
print $ARGV[0] . "\n";  # and this prints "arg1"

############################################################
# extract the parts of a hostname from the fqdn
#
#use Sys::Hostname;           # for hostname()
#my $fullname = hostname();
#my ($hostname, @name_parts) = split(/\./, $fullname);
#my $domain = join(".", @name_parts);
#print "fqdn: ", $fullname, "\n";
#print "hostname: ", $hostname, "\n";
#print "domain: ", $domain, "\n";

############################################################
# look up an ip address
#
#use Socket;               # for inet_ntoa()
#my $fqdn = hostname();
#my $packedip = gethostbyname($fqdn);
#printf "%0x \n", $packedip;
#print inet_ntoa($packedip),"\n" if defined $packedip;

############################################################
# what's my (this program's) name?
# if this file is named, e.g., tester.pl, this will print
# "found me"
#
if($0 =~ /tester/) {
	print "found me \n";
} elsif ($0 =~ /foo/) {
	print "not me \n";
} else {
	print "something else althogether \n";
}

############################################################
# get output of a command from the shell to the terminal
#
system('ls -d /tmp');  # prints "/tmp" to stdout

############################################################
# proof that matches use extended regular expressions
#
# both print "yes"
#
my $search = "dave|capella";
foreach my $s ( "foo davey bar", "foo dcapella bar" ) {
	if ( $s =~ $search ) { print "yes \n"; }
	else { print "no \n"; }
}

############################################################
# printing date ranges; months, days, years
#
# print month names as strings
#
my @months = ( "bogus", "January", "February", "March", "April", "May", "June",
							 "July", "August", "September", "October", "November", "December" );
foreach my $i (1..$#months) {   # $#months == 13
	print $months[$i];
	print "\n";
}
#
# month days
#
foreach my $i (1..31) {
	print $i . "\n";
}
#
# get all the components of the localtime
#
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year += 1900;
print $year . "\n";
if($year == 2009) { print "yes \n"; }  # prints "yes"

############################################################
# simple truth tests. these work.
my $one = 1;
my $zero = 0;
if(!$one){ print "one\n"; }    # silent
if(!$zero){ print "zero\n"; }  # prints "zero"

############################################################
# multi-line strings
# all of these print the same thing.
#
# assigning variables...
# this works fine.
#my $s = "this is a test
#this is only a test
#this is line three
#the end
#";
#print $s;
##
## and so does this.
##
#$s = <<EOM;
#this is a test
#this is only a test
#this is line three
#the end
#EOM
#print $s;
##
## or just printing...
## don't need no stinking variables
#print <<EOM;
#this is a test
#this is only a test
#this is line three
#the end
#EOM
#print "
#this is a test
#this is only a test
#this is line three
#the end
#";

############################################################
# which test to use on strings and numbers?
#
#my $i = "5";
#my $s = sprintf("%02d", $i);
## "==" for numbers
#if($i == "5") { print "i == 5 \n"; }
## "eq" for strings
#if($s eq "05") { print "s eq '05' \n"; }


############################################################
# can i push new items on an array while i iterate thru it?
#
my @ary = ( 'abc', 'bcd', 'def' );
my $x; 
foreach $x (@ary) {
  if ($x eq 'abc') {
    push @ary,'xyz';
  }
  print $x, "\n";
}

# yes
foreach $x (@ary) {
   print $x, "\n";
}

# what's my name?
#my $fqdn = hostname();

############################################################
# print an underline the same length as the current line
#
#my $sep = "\n";
#my $len = length($fqdn);
#my $div .= "-" x $len . $sep;
#print $div;
#
## or just...
#print "-" x length($fqdn) . "\n";
##
## so...
#print $div, $fqdn, "\n", $div;

#############################################################
## print my ip address
##
##my $hostent = gethostbyname($fqdn);
##print "my ip: ", inet_ntoa($hostent),"\n" if defined $hostent;
##
### keys of a hash?
###
##my %h = ( '00:00' => 1, '11:11' => 0, '22:22' => 3 );
##my @ary = keys(%h);
##
##print "array: @ary \n";
##
##print "------ \n";

############################################################
# match string
#
#my $mac = "00:01:20:aa:bb:cc";
#if( $mac =~ /00:/ ) {
#	print "yes \n";
#} else {
#	print "no \n";
#}

############################################################
# create array of args to function
#
#sub doit {
#	my @ary;
#	my $arg;
#	do {
#		$arg = shift;
#		push(@ary, $arg) if $arg;
#	} while $arg;
#	print "ary: @ary \n";
#	foreach $arg (@ary) { print "arg: $arg \n"; }
#}
#
#print "ary: @ary \n";
#doit(@ary);

);    # bogus var to comment out entire file