Recently in Snippet Category

I recently put up a copy of our main site, www.cindyruppert.com, on a new server for test purposes and pointed www.cindyruppert.net at it.  I didn't want Google (or anyone else) to see all of duplicate content, so I put some basic HTTP Authentication on it, using the .htaccess file:
Google just deprecated their image chart API that I use to create QR codes.  When I first looked into it a while ago, there wasn't a good solution that worked on the old Perl I was stuck with.   Now I'm all upgraded and looked again and found GD::Barcode::QRcode.  Works great.

This is pretty straight from the module's synopsis, but it took a second for me to get what I wanted, so I thought I'd post it.

# Create QR code with Perl

use strict;
use warnings;
use GD::Barcode::QRcode;

open my $OUT, '>', 'test.png';
binmode($OUT);

my $gd = GD::Barcode::QRcode->new(
	'http://m.cindyruppert.com',  
	{ Ecc => 'L', Version=>2, ModuleSize => 16},
);

print $OUT $gd->plot->png;
close $OUT;

I need to download a zip file and extract the contents as part of a batch process, with some fine grain control over the name and location of the extracted file.  

Never messed with zip files using Perl before, so here is the first step - a very simple example to extract the contents of a zip file to the current directory using the names in the zip file.

There is an excellent FAQ and lots of good examples in the distribution.

#!/usr/bin/perl
# 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;

Cache::FileCache Example

| No Comments
There is a spot in our real estate system that's always needed a cache to hold some data obtained from the internet. I finally got around to it using Cache::FileCache. Not the latest and greatest, but available on my increasingly antiquated system. It was hard to find a some decent example code, so here is some I wrote.

#!/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;
Figuring this out was somewhat painful, so I thought I would blog it.

I want to use the same form yaml for several different actions (update, create, view) andI had a list of field names I wanted to remove that were not relevant for create.

The remove_element method only works on the immediate children of the invoking object (as does get element), so $form->remove_element does not usually work.  I found a posting on the HTML::FormFu list where Carl Franks showed the idiom $element->parent->remove_element($element);

So my code became:

# 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!
Here is a quick script I wrote to load SQLite tables from CSV files.  I exported the files from Microsoft Access.  The first row has to have correct column names.

Text::xSV is the best CSV file handler I could find on CPAN.  It correctly handles files with embedded newlines as well as very large files.  SQL::Abstract makes it very easy to use straight DBI to speed up the load without going through an ORM. 

I prepare each row separately because I may have cases where there are trailing unused fields, and some Microsoft programs (Outlook comes to mind) do not attempt to output empty fields for them.  If the speed difference is important, you may want to try to guarantee the exact number of fields in each row so you can prepare once.

#!/usr/bin/perl

# load_csv.pl - Load a db table from a csv file.
#               First row must be field names.
# 04/28/2009  W. Ruppert

use strict;
use warnings;
use Text::xSV;
use DBI;
use SQL::Abstract;

$| = 1;

sub usage {
    my ($msg) = @_;
    warn "$msg\n" if $msg;
    die "Usage: load_csv.pl db table csvfile\n";
}

# get parms
my $db        = shift || usage "No database name";
my $table     = shift || usage "No table name";
my $data_file = shift || usage "No csv data file";

usage "No such file: $db"        unless -e $db;
usage "No such file: $data_file" unless -e $data_file;

# setup csv file
my $csv = new Text::xSV;
$csv->open_file("$data_file");
$csv->read_header();

my $sql = SQL::Abstract->new;

# connect to db
my $dbh = DBI->connect("dbi:SQLite:$db", "","",
        { RaiseError => 1, PrintError => 0 }
) or die "can't connect\n";

$dbh->do('begin');

my $max_commit  = 1000;
my $inserted    = 0;

# process csv rows
while (my %fieldvals = $csv->fetchrow_hash) {

    # SQL::Abstract sets up the DBI variables
    my($stmt, @bind) = $sql->insert($table, \%fieldvals);

    # insert the row
    my $sth = $dbh->prepare($stmt);
    $inserted += $sth->execute(@bind);

    # progress bar
    print "*"            unless $inserted % 10;
    print " $inserted\n" unless $inserted % 500;

    # commit every once in a while
    unless ($inserted % $max_commit) {
        $dbh->do('commit');
        $dbh->do('begin');
    }
}

$dbh->do('commit');
$dbh->disconnect;

print "\nInserted $inserted records\n";
exit 1;

Determine Image Size from URL

| No Comments
Need to get the size of an image on the web without storing it.  Done by pulling the image with LWP::Simple and giving the content buffer to Image::Size.



#!/usr/bin/perl
# Get dimensions of web image
# 04/17/2009  WR

use strict;
use warnings;
use LWP::Simple;
use Image::Size;

my @urls = (
	"http://www.google.com/intl/en_ALL/images/logo.gif",
	"http://l.yimg.com/a/i/ww/beta/y3.gif",
	"http://www.example.com/nothing.gif",
	"http://graphics8.nytimes.com/images/misc/nytlogo379x64.gif",
);

URL:
for my $url (@urls) {
	my $image = get $url;
	unless (defined $image) {
		warn "Couldn't get $url!\n";
		next URL;
	}
	my ($width, $height) = imgsize(\$image);
	printf "%4d %4d   %s\n", $width, $height, $url;
}

exit 1;

About this Archive

This page is an archive of recent entries in the Snippet category.

Script is the previous category.

Tools is the next category.

Find recent content on the main index or look in the archives to find all content.

Pages

OpenID accepted here Learn more about OpenID
Powered by Movable Type 4.38