Bill Ruppert

use strict;
use warnings;

use Win32::ODBC;

$| = 1;

my $dsn = "LinkManagerTest";
my $db = new Win32::ODBC($dsn)
    or die "Connect to database $dsn failed: " . Win32::ODBC::Error();

my $rows_added = 0;
my $error_code;

while (<>) {
    chomp;

    print STDERR "."     unless $. % 100;
    print STDERR " $.\n" unless $. % 5000;

    my ($source, $source_link, $url, $site_name) = split /\t/;

    my $insert = qq{
        insert into Links (
            URL,
            SiteName,
            Source,
            SourceLink
        )
        values (
            '$url',
            '$site_name',
            '$source',
            '$source_link'
        )
    };

    $error_code = $db->Sql($insert);

    if ($error_code) {
        print "\nSQL update failed on line $. with error code $error_code\n";
        print "SQL statement:\n$insert\n\n";
        print "Error:\n" . $db->Error() . "\n\n";
    }
    else {
        $rows_added++;
    }

    $db->Transact('SQL_COMMIT') unless $. % 1000;
}

$db->Transact('SQL_COMMIT');
$db->Close();

print "\n";
print "Lines Read: $.\n";
print "Rows Added: $rows_added\n";

exit 0;

# extract_zip.pl - very simple zip extract example

use strict;
use warnings;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );

my $zip_name = "example.zip";

my $zip = Archive::Zip->new($zip_name);
unless (defined $zip) {
	die "Unable to open $zip_name\n";
}

print "The zip file contains ", $zip->numberOfMembers(), " members:\n";

for my $member_name ($zip->memberNames()) {
	print "  Extracting $member_name\n";
	my $status = $zip->extractMemberWithoutPaths($member_name);
	die "\nExtracting $member_name from $zip_name failed\n" if $status != AZ_OK;
}

exit 1;

#!/usr/bin/perl

# tCacheFile.pl - try out Cache::FileCache
# 04/29/2011  Bill Ruppert

use strict;
use warnings;
use Cache::FileCache;

# Setup cache
my $cache = new Cache::FileCache({ 
	namespace           => 'FruitCache',
	default_expires_in  => '100 days',
	cache_root          => 'C:/tools/cache/',
	auto_purge_interval => '1 day',
});

# Cache some items
$cache->set('Orange', 'A round citrus fruit');
$cache->set('Lemon',  'A yellow pointed sour citrus fruit');
$cache->set('Apple',  'A red roundish fruit good for pies');

# Get all items in cache
print "Get all items in cache:\n";
for ($cache->get_keys()) {
	my $data = $cache->get($_);
	printf "  %-10s: %s\n", $_, $data;
}

# Mix cache hits and misses
print "\nTry some hits and misses:\n";
for (qw( Lemon Kiwi Orange Melon Apple )) {
	my $data = $cache->get($_);
	$data = "Not cached!" unless defined $data;
	printf "  %-10s: %s\n", $_, $data;
}

exit 1;

# dnstimes.pl - test dns server times

use strict;
use warnings;

my @urls = qw(
	lifehacker.com
	facebook.com
	manu-j.com
	reddit.com
	tb4.fr
	bbc.co.uk
	cindyruppert.com
);

my %dns_servers = (
	Level_3	=> '4.2.2.2',
	Google	=> '8.8.8.8',
	OpenDNS	=> '208.67.222.222',
);

for my $dns_firm (sort keys %dns_servers) {
	my $dns_ip = $dns_servers{$dns_firm};
	for my $url (@urls) {
		my $result = `dig \@$dns_ip $url`;
		my ($time) = $result =~ /Query time: (\d+)/s;
		print "$dns_firm\t$url\t$time\n";
	}
}

# remove fields not needed for this action
for (qw(created_by created_time changed_by changed_time version)) {
	my $element = $form->get_all_element({name => $_});
	if ($element) {
		$element->parent->remove_element($element);
	}
}


Works great!

use strict;
use warnings;
 
use WWW::Google::PageRank;

my @hosts = (
	"toolbarqueries.google.com",
	"209.85.227.147",
	"209.85.227.104",
);

for my $host (@hosts) {
	print "\n$host\n";
	my $pr = WWW::Google::PageRank->new(host => $host)
		or die $!;
	for my $domain (@ARGV) {
		$domain =~ s{http://}{};
		$domain =~ s{/$}{};
		my $pagerank = $pr->get("http://$domain/");
		print "    $pagerank  $domain\n";
	}
}

#!/usr/bin/perl

# delold.pl - delete old files

#-----------------------------------------------------------
# 05/24/2009  WR  Written
#-----------------------------------------------------------

use strict;
use warnings;
use Win32::Autoglob;
use Getopt::Long;

$| = 1;

sub print_usage;
sub abort_usage;

# option defaults
my $days_back    = 10;
my $test_flag    = 0;
my $verbose_flag = 0;
my $quiet_flag   = 0;

# get options
GetOptions (
    'days=i'  => \$days_back,
    'test'    => \$test_flag,
    'verbose' => \$verbose_flag,
    'quiet'   => \$quiet_flag,
    'usage'   => sub {print_usage; exit 1},
) or abort_usage "Invalid option";

my $time = time();

my $files_to_delete = 0;
my $files_total     = 0;
my $files_failed    = 0;

FILE:
for my $file (@ARGV) {

    # must exist, must be a plain old file
    next FILE if !-e $file;
    next FILE if !-f $file;

    $files_total++;

    # modified age in days
    my ($mtime) = (stat($file))[9];
    my $modified_age = ($time - $mtime) / (3600 * 24);

    # skip if too young
    next FILE if $modified_age < $days_back;
    
    $files_to_delete++;

    if ($test_flag || $verbose_flag) {
        printf "Age: %-6.1f  File: %s\n",
            $modified_age,
            $file;
    }

    # skip if we are testing
    next FILE if $test_flag;

    # delete the file
    if (!unlink $file) {
        warn "Failed to delete file $file\n";
        $files_failed++;
    }

}

if ($test_flag) {
    print "\nTest Flag is set, no deletes done!\n";
}

my $files_remaining = $files_total - $files_to_delete + $files_failed;

if (!$quiet_flag || $test_flag) {
    print "\n";
    print "Total files:      $files_total\n";
    print "Files to delete:  $files_to_delete\n";
    print "Failed to delete: $files_failed\n";
    print "Files remaining:  $files_remaining\n";
}

exit 1;

sub abort_usage {
    print STDERR join("\n", @_), "\n" if @_;
    print_usage;
    exit 0;
}

sub print_usage {
    print STDERR <<END;
Usage: delold.pl [Options] files...
Options:
    --days n      - Set age of files to keep.
                    Files over "days" old will be deleted.
                    Default is 10 days.
    --test        - Print file names to be deleted with age,
                    but do not actually delete.
                    Default is false.
    --verbose     - Print file name and age while deleting.
                    Default is false.
    --quiet       - Suppress printing of totals after deleting.
                    Default is false.
    --usage       - print this message and exit
END
}