Re^2: (RFC) XML::Rules - yet another XML parser

[Jenda]

The code would look like this:

my ($message_count, $sent_count);
my $parser = new XML::Rules (
    rules => [
    _default => 'content',
    message => sub {
        $message_count++;
        Mail::Sendmail::sendmail(
            from => $_[1]->{from},
            to => $_[1]->{to},
            subject => $_[1]->{subject},
            body => $_[1]->{body},
        )
            or warn "Mail Error: $Mail::Sendmail::error";
        $sent_count++ unless $Mail::Sendmail::error;
        return;
    },
    messages => sub {
        print "SAX Mailer Finished\n$sent_count of $message_count mess
+age(s) sent\n";
        return;
    }
]);
$parser->parsefile($file);

or, if you did not want to use any external variables:

my $parser = new XML::Rules (
    rules => [
    _default => 'content',
    message => sub {
        $_[3][-1]->{message_count}++;
        Mail::Sendmail::sendmail(
            from => $_[1]->{from},
            to => $_[1]->{to},
            subject => $_[1]->{subject},
            body => $_[1]->{body},
        )
            or warn "Mail Error: $Mail::Sendmail::error";
        $_[3][-1]->{sent_count}++ unless $Mail::Sendmail::error;
        return;
    },
    messages => sub {
        print "SAX Mailer Finished\n$_[1]->{sent_count} of $_[1]->{mes
+sage_count} message(s) sent\n";
        return;
    }
]);
$parser->parsefile($file);

or

my $parser = new XML::Rules (
    rules => [
    _default => 'content',
    message => sub {
        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
        $parent_data->[-1]->{message_count}++;
        Mail::Sendmail::sendmail(
            from => $tag_hash->{from},
            to => $tag_hash->{to},
            subject => $tag_hash->{subject},
            body => $tag_hash->{body},
        )
            or warn "Mail Error: $Mail::Sendmail::error";
        $parent_data->[-1]->{sent_count}++ unless $Mail::Sendmail::err
+or;
        return;
    },
    messages => sub {
        print "SAX Mailer Finished\n$_[1]->{sent_count} of $_[1]->{mes
+sage_count} message(s) sent\n";
        return;
    }
]);
$parser->parsefile($file);

I guess I should add a few more ways to add data to the parent node. Apart from 'attributename' that sets (and if needed overwrites) the attribute and '@attributename' that appends the value to the array I should also allow '+attributename' and '.attributename'. '-attributename' is not needed, but I wonder whether to add '*attributename'.

With the '+attributename' the code would look like this:

my $parser = new XML::Rules (
    rules => [
    _default => 'content',
    message => sub {
        Mail::Sendmail::sendmail(
            from => $_[1]->{from},
            to => $_[1]->{to},
            subject => $_[1]->{subject},
            body => $_[1]->{body},
        )
            or warn "Mail Error: $Mail::Sendmail::error";
        return '+message_count' => 1, '+sent_count' => ($Mail::Sendmai
+l::error ? 0 : 1);
    },
    messages => sub {
        print "SAX Mailer Finished\n$_[1]->{sent_count} of $_[1]->{mes
+sage_count} message(s) sent\n";
        return;
    }
]);
$parser->parsefile($file);

All code except the last snippet is tested :-)

I'll have a look at SAX, currently the module sits on top of XML::Parser:Expat, but I think it should not be a big deal to change that. Or to change the code so that you can choose what to use.