Newsgroup: comp.sys.palmtops


Path: doc.ic.ac.uk!doc.ic.ac.uk!not-for-mail
From: dds@doc.ic.ac.uk (Diomidis D Spinellis)
Newsgroups: comp.sys.palmtops,comp.lang.perl
Subject: Re: HP95: How to soft Phone Book entries?
Date: 15 Sep 1992 13:32:37 +0100
Organization: Department of Computing, Imperial College, University of London, UK.
Lines: 114
Message-ID: <194l55INNqao@swan.doc.ic.ac.uk>
References: <112160040@hpfcso.FC.HP.COM> <112160041@hpfcso.FC.HP.COM>
NNTP-Posting-Host: swan.doc.ic.ac.uk
Summary: perl script to fix it
Content-Length: 4304
In article <112160041@hpfcso.FC.HP.COM> rrd@hpfcso.FC.HP.COM (Ray Depew) writes:
>My brain slipped a gear when I was creating my Phone Book, and I was entering 
>all names first-name-first.  (It's been years since I encountered people who 
>referred to themselves as "Benedetti Giorgio" instead of "Giorgio Benedetti.")
>
>My Phone Book, as several of you privately and charitably pointed out, is
>ALREADY sorted:  with "Alan" at the beginning and "Tom" at the end.  Well,
>tie me to an anthill and smear my ears with jelly.
>
>I'll go back and edit all of the entries the hard way.  Chalk up another one 
>to User Screwups.

There is the Hard way and there is the Perl way.  It took 10 minutes to write
the following Perl script that does the job.  I hope it helps.

Diomidis

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	phonesort
# This archive created: Tue Sep 15 13:31:34 1992
export PATH; PATH=/bin:$PATH
echo shar: extracting "'phonesort'" '(2480 characters)'
if test -f 'phonesort'
then
	echo shar: will not over-write existing file "'phonesort'"
else
sed 's/^X//' << \SHAR_EOF > 'phonesort'
X#!/usr/local/bin/perl
X#
X# Sort an HP95LX phone book after changing the name order from 
X# "first last" to "last first"
X# 
X# (C) Copyright 1992 Diomidis Spinellis.   All rights reserved.
X#
X# Permission to use, copy, and distribute this software and its
X# documentation for any purpose and without fee is hereby granted,
X# provided that the above copyright notice appear in all copies and that
X# both that copyright notice and this permission notice appear in
X# supporting documentation.
X# 
X# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
X# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
X# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
X#
Xif ($#ARGV != 1) {
X	print STDERR "usage: $0 infile outfile\n";
X	exit 1;
X}
X$ifile = $ARGV[0];
X$ofile = $ARGV[1];
Xopen(PB, $ifile) || die "Unable to open $ifile: $!\n";
Xopen(PBN, ">$ofile") || die "Unable to open $ofile: $!\n";
Xbinmode PB;
Xbinmode PBN;
Xread(PB, $head, 5) == 5 || die "EOF on file head read: $!\n";;
Xprint PBN $head;
X($codel, $codeh, $rell, $relh, $type) = unpack('CCCCC', $head);
Xif ($codel != 0xfe && $codeh != 0xff) {
X	printf (STDERR "Invalid product code: %02x%02x\n", $codeh, $codel);
X	exit 1;
X}
Xif ($rell != 1 && $relh != 0) {
X	printf (STDERR "Invalid release number: %02x%02x\n", $relh, $rell);
X	exit 1;
X}
Xif ($type != 3) {
X	printf (STDERR "Invalid file type: %02x", $type);
X	exit 1;
X}
Xfor (;;) {
X	read(PB, $rechead, 3) == 3 || die "EOF on record head read: $!\n";
X	($type, $lenl, $lenh) = unpack('CCC', $rechead);
X	last if ($type == 2);
X	if ($type != 1) {
X		printf (STDERR "Invalid record type: %02x", $type);
X		exit 1;
X	}
X	$len = ($lenh << 8) | $lenl;
X	read(PB, $recd, $len) == $len || die "EOF on record read: $!\n";
X	($namelen, $numberlen, $addrlenl, $addrlenh) = unpack('CCCC', $recd);
X	$name = substr($recd, 4, $namelen);
X	$number = substr($recd, 4 + $namelen, $numberlen);
X	$addrlen = ($addrlenh << 8) | $addrlenl;
X	$address = substr($recd, 4 + $namelen + $numberlen, $addrlen);
X	$name =~ s/(^.*)\s+(\w+)$/$2 $1/;
X	push(@entry, join("\1", $name, $number, $address));
X}
X@entry = sort @entry;
Xwhile ($entry = shift @entry) {
X	$len = length($entry) - 2 + 4;
X	print PBN pack('CCC', 1, $len & 0xff, ($len >> 8) & 0xff);
X	($name, $number, $address) = split("\1", $entry);
X	$len = length($address);
X	print PBN pack('CCCC', length($name), length($number), $len & 0xff, ($len >> 8) & 0xff);
X	print PBN $name, $number, $address;
X}
Xprint PBN pack('CCC', 2, 0, 0);
Xexit 0;
SHAR_EOF
if test 2480 -ne "`wc -c < 'phonesort'`"
then
	echo shar: error transmitting "'phonesort'" '(should have been 2480 characters)'
fi
chmod +x 'phonesort'
fi # end of overwriting check
#	End of shell archive
exit 0
-- 
Diomidis Spinellis    Internet: <dds@doc.ic.ac.uk>  UUCP: ...!uknet!icdoc!dds
Department of Computing, Imperial College, London SW7     #include "/dev/tty"



Newsgroup comp.sys.palmtops contents
Newsgroup list
Diomidis Spinellis home page

Creative Commons License Unless otherwise expressly stated, all original material on this page created by Diomidis Spinellis is licensed under a Creative Commons Attribution-Share Alike 3.0 Greece License.