Feeds:
Posts
Comments

Posts Tagged ‘perl’

I’m a huge fan of code reuse, and I tend to trust other people’s public code more than my own private code. After all, if they put effort into making it public, they must have put a lot of thought into it. And more than likely it is probably their speciality. That’s why I don’t (for example) implement my own webservers :) Having said that, I’ve reimplemented more wheels than I care to admit. Here is me, providing my own version of identity – a built-in emacs function. How embarrassing. Almost put me off blogging that did.

So, I try to do a bit of due dilligence when I’m thinking about writing a simple thing that someone surely has already done. What I want, is an interprocess mutex. There must be a million ways of doing these things, so I have a quick look on CPAN. Searching for mutex brings up LockFile::NetLock which looks interesting (although slightly paranoid, and I don’t have my own ftp server).

IPC::Semaphore looks like it only supports SysV (i.e. not Windows) and the API is somewhat baroque. Win32::Semaphore has the opposite problem (I’m guessing). I did like the look of POSIX::RT::Semaphore but suspected it wouldn’t install on Windows.

dmake.EXE:  Error code 129, while making 'Semaphore.o'
  MJP/POSIX-RT-Semaphore-0.05.tar.gz
  C:\strawberry\c\bin\dmake.EXE -- NOT OK
Running make test
  Can't test without successful make
Running make install
  Make had returned bad status, install seems impossible

Yep, I was right. I’ll spare you the results from the other hour I spent googling various things like semaphore and process mutex.

Okay, let’s think about this. Maybe I could write my own simple little thing with a nice API, and if I find a decent module later I can delegate to it, or maybe delegate to Win32::Semaphore on Windows and the SysV version everywhere else. The ACE guys call that a wrapper facade. Does flock work on Windows?

So the plan is to call flock LOCK_EX on a file in the constructor, and then flock LOCK_UN in the destructor in a kinda RAII way. Famous last words, but what else could I possibly need?

package IPC::ProcessMutex;

use Carp;
use Fcntl;

sub import { }

sub new
{
    my $class = shift;
    my $file = shift;

    my $fh;
    if (! sysopen($fh, $file, O_CREAT)) {
        croak "Unable to sysopen $file";
    }

    my $self = { handle => $fh };
    bless $self, $class;

    flock $fh, Fcntl::LOCK_EX;

    return $self;
}

sub DESTROY
{
    my $self = shift;

    if (exists $self->{handle}) {
        flock $self->{handle}, Fcntl::LOCK_UN;
        close $self->{handle};
        delete $self->{handle};
    } else {
        carp 'DESTROY - handle was not defined';
    }
}

1;

And to avoid having to think to hard about whether the code actually works or not, I’ll check it with a little test ;)

use POSIX;
use FindBin;

use lib "$FindBin::Bin/lib/perl5";

use IPC::ProcessMutex;

sub my_log
{
    my $ts = POSIX::strftime('%H:%M:%S', localtime(time()));
    print "[ $ts ] : ", @_, "\n";
}

{
    my_log 'Getting mutex ...';
    my $mutex = IPC::ProcessMutex->new('.filename.lock');
    my_log 'Got mutex.  Sleeping 10 ...';
    sleep 10;
}

my_log 'Released mutex.';

Process 1

jared@win32 $ perl get-mutex.pl
[ 21:37:57 ] : Getting mutex ...
[ 21:37:57 ] : Got mutex.  Sleeping 10 ...
[ 21:38:07 ] : Released mutex.
jared@win32 $ perl get-mutex.pl
[ 21:38:15 ] : Getting mutex ...
[ 21:38:17 ] : Got mutex.  Sleeping 10 ...
[ 21:38:27 ] : Released mutex.
jared@win32 $

Process 2

jared@win32 $ perl get-mutex.pl
[ 21:38:02 ] : Getting mutex ...
[ 21:38:07 ] : Got mutex.  Sleeping 10 ...
[ 21:38:17 ] : Released mutex.
jared@win32 $ perl get-mutex.pl
[ 21:38:24 ] : Getting mutex ...
[ 21:38:27 ] : Got mutex.  Sleeping 10 ...
[ 21:38:37 ] : Released mutex.
jared@win32 $

Yes! Mission accomplished as they say. I’m tentatively going to go with that…

Read Full Post »

Something a casual user of a language will miss out on, is using the latest and greatest libraries of that language and generally programming in a modern style. For example, I1 still naturally use open(FH, 'filename') || die; and have to force myself to use the more modern open(my $fh, '<', 'filename') with its lexically scoped filehandle.

I have been programming Perl for 12 years or so, but aside from one conference (YAPC Muenchen 2002) I’ve never really immersed myself in the community. For this reason, I think I have missed out on quite a few niceties. Moose, DBIx and other modules bring Perl up to the level of its contemporaries if you don’t need to work with people who are not using them. I only came across POE recently (which I keep mentioning because it is so awesome).

Heck, even C++ has boost.

Modifiable Syntax

or DSLs I think they call it.

Ray Dillinger once pointed out that people write scheme in a variety of incompatible styles because the substrate isn’t pleasant for programming on directly. But it is possible to layer any sugar you like on it. This leads to a bunch of different and practically incompatible styles.

Anyway, what I see is that scheme programmers are capable of
doing a heck of a lot as individuals, and are very happy with
the personally-customized language they each work with. But
they tend not to work together on large projects because of
the cognitive overhead of learning each other’s personally-
customized languages, which may have different or conflicting
definitions.

Common Lisp programmers, by contrast, have a lot of standard
libraries and tend to forgive or ignore some small things that
may not fit perfectly with their personal style. But they do
work together on large projects, because they all have the same
set of language extensions and they can read each other’s code.

I still find eager comprehensions about the nicest way of specifying nested loops that I’ve seen. Perl syntax tweaking dudes: if you add these, I’ll never switch! What’s that? Fix it myself? It is easier to move to python or ruby I think.

Is it a coincidence that languages with fixable syntax (Lisp, Perl, Tcl, Ocaml) have ‘lost’ to those with a fixed syntax (Java, Python)? Ruby dudes beware.

Supporting Your Language

There have been a few posts floating around the blogosphere talking about writing posts supporting perl. I put my own effort into doing something similar for Emacs. However, in my opinion, Emacs needs the help and Perl does not.

Emacs could be greatly improved if there were many more Emacs Lisp hackers creating libraries and writing examples and documentation. Perl already has all of those things. <strike>As</strike> If its popularity wanes, what is lost? I guess people are thinking about job opportunities and stuff like that, but I suspect that the outflow of former Perl programmers will outpace the loss of Perl jobs.

Er, So what is my point?

Oh yes, Emacs-using Perl dudes, please add eager comprehensions to Perl and write Emacs blog posts rather than Perl ones. Thank you.


1. Even though I’m not really a casual Perl user. I do this stuff professionally don’t you know ;)

Read Full Post »

Okay, this post is going to be quite long. I’m going to start with a basic problem I was solving in emacs lisp. From there I’ll segue into thinking about looping syntax and finally I’ll do a bit of benchmarking as I’ve got the code already and people seem to like that (the scheme, ocaml, c++ speed comparison is by far the most popular post on this blog followed by this).


Futzing around with Project Euler is something I do for fun. Most recently I was looking at problem 73 – count the reduced proper fractions with a denominator less than or equal to 10,000 between 1/3 and 1/2.

Emacs Lisp Solution

Emacs Lisp is usually my default language for doing this kind of thing as I’m already in my text editor and there is a REPL to experiment with.

First of all, it is clear that I’m going to need a function to calculate the greatest common divisor. I found an imperative Pascal implementation of Euclid’s algorithm here. A brief aside – I searched for Pascal deliberately as I generally find it very clear. Does anyone else do that?

(defun gcd (a b)
  (while (not (= b 0))
    (let ((tmp b))
      (setq b (% a b))
      (setq a tmp)))
  a)

Thinking ahead, I’ll probably know what the gcd is before we call make-fraction as only fractions with a gcd of 1 will be actually counted amongst the solutions. I’ve therefore made gcd an optional parameter as a nod to efficiency.

(defsubst make-fraction (num denom &optional gcd)
  (unless gcd (setq gcd (gcd num denom)))
  (cons (/ num gcd) (/ denom gcd)))

I like the flexibility that lisp-like languages give you to name your functions too.

(defsubst more-than-1/3 (frac)
  (let ((num (car frac))
        (denom (cdr frac)))
    (> (* num 3) denom)))

(defsubst less-than-1/2 (frac)
  (let ((num (car frac))
        (denom (cdr frac)))
    (< (* num 2) denom)))

(defsubst within-range (frac)
  (and (more-than-1/3 frac) (less-than-1/2 frac)))

We only check fractions between 1/3 and 1/2 as to do all fractions with a denominator <= 10,000 would take far too long.

(defun solve-it (max-denom)
  (insert (format-time-string "\n\nStarted at: %H:%M:%S\n\n"))
  (let (num denom frac max gcd solutions)
    (setq solutions 0)
    (setq denom 2)
    (while (<= denom max-denom)
      (setq num (/ denom 3))
      (setq max (1+ (/ denom 2)))
      (while (<= num max)
        (setq gcd (gcd num denom))
        (when (= gcd 1)
          (setq frac (make-fraction num denom gcd))
          (when (within-range frac)
            ;; (insert (format "%s\n" frac))
            (incf solutions)))
        (incf num))
      (incf denom)
      (when (= (% denom 50) 0)
        (insert (format "Denom: %d Solutions: %d\n" denom solutions)))
      (sit-for 0))
    (insert (format "\n%d solutions\n" solutions))
    (insert (format-time-string "Finished at: %H:%M:%S\n"))))

After I wrote this, I realised I didn’t need to construct and destruct my fraction type so simplified to the following:

(defun solve-it (max-denom)
  (insert (format-time-string "\n\nStarted at: %H:%M:%S\n"))
  (let (num denom frac max solutions)
    (setq solutions 0)
    (setq denom 5)
    (while (<= denom max-denom)
      (setq num (1+ (/ denom 3)))
      (setq max (/ denom 2))
      (while (<= num max)
        (when (= (gcd num denom) 1)
          (incf solutions))
        (incf num))
      (incf denom))
    (insert (format "%d solutions\n" solutions))
    (insert (format-time-string "Finished at: %H:%M:%S\n"))))

(solve-it 10000)

;; Started at: 22:14:35
;; 5066251 solutions
;; Finished at: 22:15:45

70 seconds. Okay.

The most annoying thing is the primitive looping constructs. while is the basic and obvious built-in. It also has a slew of macros beginning with doXXX including dotimes and dolist not to mention the mighty common lisp loop macro.

I don’t know loop (but I’m going to learn it), but after messing about with do* for a few minutes, I realised it wasn’t the looping construct for me.

(do* ((i 5 (if (> j 10) (+ i 1) i))
      (j (+ i 1) (if (> j 10) (+ i 1) (+ j 1))))
    ((> i 10))
  (insert (format "[%d %d]" i j)))

Yuck.

Now, the great thing about lisp is supposed to be that if you don’t like the syntax you can add your own with macros. Unfortunately, I haven’t got around to that yet as a bunch of people have already designed most of the syntax I like.

Scheme Solution

When I read some of the earlier posts on this blog, it seems that scheme has got some nice generator syntax (aka eager comprehensions) for handling nested loops.

There are a nice set of posts on eager comprehensions here.

I took print-ln from the portable scheme post and gcd from SICP.

#lang scheme/base

(require srfi/42)

(define (print-ln . args)
  (for-each display args)
  (newline)
  (flush-output))

(define (gcd a b)
  (if (= b 0) a
      (gcd b (remainder a b))))

(define (solve-it max-denom)
  (sum-ec (:range denom 2 (+ max-denom 1))
          (:range num (+ (floor (/ denom 3)) 1) (ceiling (/ denom 2)))
          (if (= (gcd num denom) 1) 1 0)))

(print-ln "There are " (solve-it 10000) " solutions")

Yikes, mzscheme is much quicker than emacs-lisp. That surprised me. A factor of 10 I would have expected, a factor of 50 not so much.

$ time mzscheme frac.scm
There are XXX solutions

real    0m1.413s
user    0m1.404s
sys     0m0.004s

Perl Solution

use strict;
use warnings;

use POSIX qw(floor ceil);

sub gcd
{
    my ($n1, $n2) = @_;
    until ($n2 == 0) {
        my $tmp = $n2;
        $n2 = $n1 % $n2;
        $n1 = $tmp;
    }
    return $n1;
}

The nested loop actually looks okay to me in perl although not as nice as the srfi-42 eager comprehensions.

sub solve_it
{
    my $max_denom = $_[0];
    my $solutions = 0;
    foreach my $denom (5..$max_denom) {
        my $max = ceil($denom / 2) - 1;
        foreach my $num ((1 + floor($denom / 3))..$max) {
            if (gcd($num, $denom) == 1) {
                ++$solutions;
            }
        }
    }
    return $solutions;
}

printf "There are %d solutions\n", solve_it(10000);

The performance of my perl is pretty bad too.

$ time perl frac.pl
There are XXX solutions

real    0m47.026s
user    0m46.963s
sys     0m0.008s

Ocaml Solution

let rec gcd a b =
  if b = 0 then a
  else gcd b (a mod b);;

let solve_it max_denom =
  let rec loop num denom solutions =
    if denom > max_denom then solutions
    else if num >= (denom/2+1) then
      loop ((denom+1)/3+1) (denom+1) solutions
    else begin
      if gcd num denom = 1 then begin
        (* Printf.printf "%d/%d\n" num denom; *)
        loop (num+1) denom (solutions+1)
      end else
        loop (num+1) denom solutions
    end
  in
    loop ((5/3)+1) 5 0;;

Printf.printf "There are %d solutions\n" (solve_it 1000);;

Oh dear, I seem to have an awful accent when programming ocaml. I’ll need to work on that.

$ time ./a.out
There are XXX solutions

real    0m1.071s
user    0m1.060s
sys     0m0.004s

So, Conclusions

For this particular task (looping and integer math) Emacs Lisp is slow, but not that slow compared with another scripting language. I really like the scheme looping constructs and mzscheme is surprisingly quick (again, just for this tiny thing), not too far from the ocaml – although again I should emphasise that the ocaml is a terrible hack. And finally, I need to learn how to use loop properly.

All comments welcome.

Read Full Post »

So much for good intentions. I get myself all geared up to
the problem I need to solve today? Well, I want to find out about how emacs networking works.

So first, I need a simple server to play with. Now normally when I think server I automatically think Apache but this time I want something a bit more basic. And if I was thinking enterprise1 I might reach for C++/ACE. However, for something basic, Perl is ideal.

I’ve just upgraded to Ubuntu 9.04 on this box and Perl is unused so let’s see if it has what I need.

06.52 Ubuntu finishes booting

I waste a few minutes on the internet.

06.57 I start Emacs

and remind myself just how gorgeous emacs-23 looks.

06.59 I check for the Net::Server package
$ perldoc Net::Server
You need to install the perl-doc package to use this program.
$ sudo apt-get install perl-doc

$ perldoc Net::Server
No documentation found for "Net::Server".

It is not installed. I could install it using apt (it is called libnet-server-perl) but I’ve got in the habit of using Perl’s CPAN module which provides package management facilities too. The advantage is that it is somewhat consistent across platforms.

$ sudo perl -MCPAN -e shell

cpan[1]> install YAML
cpan[2]> install CPAN
cpan[3]> reload CPAN
cpan[4]> install Bundle::CPAN

The CPAN bundle installs quite a bit so I go for breakfast.

07.15 Back from breakfast
cpan[5]> install Net::Server

I took this code pretty much straight from perldoc Net::Server.

#!/usr/bin/perl

use strict;
use warnings;

package SimpleServer;

use base qw(Net::Server);

sub process_request
{
    while (<STDIN>) {
        s/\r?\n$//;
        print STDERR "Received [$_]\n";
        last if /quit/i;
    }
}

SimpleServer->run(port => 8080);

I tested it using telnet localhost 8080 to confirm it does what I need.

07.20 All done

Presumably Python and Ruby have similar incantations that will get a server up and running quickly.

And unfortunately at this point I have to go to work. But later on, I can begin experimenting with emacs networking.


1. i.e. some thing that grows humongous over a period of two years and then no-one wants to work with it anymore.

Read Full Post »

Pretty Printing XML

During the course of a typical workday, in order to track down a problem, I often need to look at logfiles containing xml. The xml is usually poorly formatted and sometimes it is all on one line, making it very difficult to read. What would be ideal would be if I could extract the xml I am interested in into a buffer and pretty-print it with very little effort. The steps would be something like:

  1. create a new buffer called *xml* in another window (C-x 4 b)
  2. delete anything that exists in that buffer already
  3. pretty print the xml into the new buffer

Did I gloss over step 3? That sounds pretty complicated right? Well, I can call a simple perl script from emacs. I’m pretty pragmatic and I don’t feel the need to code absolutely everything in emacs-lisp.

#!/usr/bin/perl

use XML::Twig;
use XML::Parser;

my $xml = XML::Twig->new(pretty_print => 'indented');

if ($ARGV[0]) {
    $xml->parse($ARGV[0]);
} else {
    $xml->parse(\*STDIN);
}

$xml->print();
(defun xml-pretty-print-region (start end)
  (interactive "r")
  (let ((b (get-buffer-create "*xml*")))
    (switch-to-buffer-other-window b)
    (xml-mode)
    (erase-buffer)
    (other-window -1)
    (goto-char end)
    (let ((e (point-marker)))
      (join-broken-lines start end)
      (call-process-region start e "xml_pretty_print.pl" nil b))))

Actually, sgml-mode (xml-mode is just an alias) has a method called sgml-pretty-print but firstly I prefer the output from XML::Twig and secondly it is nice to see how easy emacs makes it to call out to an external process and return the results. Anyone without perl installed might prefer to replace the external call with a call to (sgml-pretty-print ...).

(defun xml-pretty-print-region (start end)
  (interactive "r")
  (let ((cb (current-buffer))
        (buf (get-buffer-create "*xml*")))
    (set-buffer buf)
    (erase-buffer)
    (set-buffer cb)
    (copy-to-buffer buf start end)

    (switch-to-buffer-other-window buf)
    (xml-mode)
    (join-broken-lines (point-min) (point-max))
    (sgml-pretty-print (point-min) (point-max))
    (other-window -1)))

What is that call to (join-broken-lines ...)? When I cut and paste from putty it breaks lines at the width of my window.

<?xml version="1.0" encoding="UTF-8"?><xsl:stylesheet version="1.0"><xsl:output
 method="html"/><xsl:template match="/"><H2>Customer Listing (in Alternating ro
w colors)</H2><table border="1"><xsl:for-each select="/customers/customer"><tr>
<xsl:choose><xsl:when test="position() mod 2 = 1"><xsl:attribute name="class">c
lsOdd</xsl:attribute></xsl:when><xsl:otherwise><xsl:attribute name="class">clsE
ven</xsl:attribute></xsl:otherwise></xsl:choose><xsl:for-each select="@*"><td><
xsl:value-of select="."/></td></xsl:for-each></tr></xsl:for-each></table><H3>To
tal Customers<xsl:value-of select="count(customers/customer)"/></H3></xsl:templ
ate></xsl:stylesheet>

This invalidates the xml so I need to fix this before passing the result to the xml parser.

(defconst cr (string ?\n))
(defconst *broken-line-regex* cr)

(defun join-broken-lines (start end)
  (interactive "r")
  (goto-char start)
  (while (re-search-forward *broken-line-regex* end t)
    (replace-match "" nil nil)))

This is the output from the version which calls (sgml-pretty-print ...)

<?xml version="1.0" encoding="UTF-8"?>
<xsl:stylesheet version="1.0">
  <xsl:output method="html"/>
  <xsl:template match="/">
    <H2>Customer Listing (in Alternating row colors)
    </H2>
    <table border="1">
      <xsl:for-each select="/customers/customer">
        <tr>
          <xsl:choose>
            <xsl:when test="position() mod 2 = 1">
              <xsl:attribute name="class">clsOdd
              </xsl:attribute>
            </xsl:when>
            <xsl:otherwise>
              <xsl:attribute name="class">clsEven
              </xsl:attribute>
            </xsl:otherwise>
          </xsl:choose>
          <xsl:for-each select="@*">
            <td>
              <xsl:value-of select="."/>
            </td>
          </xsl:for-each>
        </tr>
      </xsl:for-each>
    </table>
    <H3>Total Customers
      <xsl:value-of select="count(customers/customer)"/>
    </H3>
  </xsl:template>
</xsl:stylesheet>

We probably want a function to handle the common case is where all the xml is on one line with some junk before the xml and some junk afterwards. E.g.

asdflkjnalkjnasdf <?xml version="1.0" encoding="UTF-8"?><a><b>c</b></a> xskldfgjnskldf
(defun xml-pretty-print-current ()
  (interactive)
  (save-excursion
    (end-of-line nil)
    (re-search-backward ">" 1)
    (let ((e (+ 1 (point))))
      (beginning-of-line nil)
      (re-search-forward "<?xml[^>]*>" e)
      (xml-pretty-print-region (point) e))))

And, er, I guess that’s all I’ve got to say about that.

Read Full Post »

« Newer Posts

Follow

Get every new post delivered to your Inbox.