Dare to script tree-based XML with Perl

 
# -----------------------------------------------------------------------
# DOM tutorial.
# 
# Author: Parand Tony Darugar , tdarugar@velocigen.com
# -----------------------------------------------------------------------

use XML::DOM;
use XML::XQL;
use XML::XQL::DOM;

my $file = shift;

# Read and parse the document
my $parser = new XML::DOM::Parser;
my $doc = $parser->parsefile ($file); 

# Setup the database connection

use DBI;
my $dsn = "DBI:mysql:database=test;";
my $dbh = DBI->connect($dsn);

# For each stock_quote, we need the symbol first
# then we need the field corresponding to the rule in the database

foreach my $stock_quote ($doc->getElementsByTagName("stock_quote")) {
  # Get the symbol
  my @symbol_nodes = $stock_quote->getElementsByTagName("symbol");
  my $symbol_node  = $symbol_nodes[0];

  # Get the text value from the symbol node
  my $symbol       = $symbol_node->getFirstChild->getData();
  print "** Dealing with $symbol: **************\n";
  
  # Grab the rules for the given stock from the rules table
  my $sth = $dbh->prepare("select * from rules where symbol='$symbol'");
  $sth->execute();
  
  while (my $ref = $sth->fetchrow_hashref()) {
    my $field   = $ref->{'field'};
    my $value   = $ref->{'value'};
    my $action  = $ref->{'action'};
    print "Handling rule: if ($field > $value) take action $action.\n";
    
    # We can now fetch the value of the field 'field' from the XML file
    my @matching_fields = $stock_quote->getElementsByTagName($field);
    my $matching_field  = $matching_fields[0];

    my $value_from_xml;
    if ($field eq "price") {
      my @ask_price_nodes = $stock_quote->xql("price[\@type='ask']");
      my $ask_price_node  = $ask_price_nodes[0];
      $value_from_xml = $ask_price_node->getAttribute('value');
    } else {
      # Get the text value from the matching field
      $value_from_xml  = $matching_field->getFirstChild->getData();
    }

    print "Value for $field from xml value = $value_from_xml\n";
    
    if ($value_from_xml > $value) {
      # This rule applies
      print "Rule \"$field > $value\" applies for $symbol\n";
      take_action($symbol, $action);
    } else {
      print "Rule \"$field > $value\" does not apply for $symbol, no action taken.\n";
    }   
  }
  $sth->finish();
}

# Disconnect from the database
$dbh->disconnect();

# ----------------------------------------------------------------
# 
# This function would perform the given action (eg. buy or sell)
# on the given stock. In this case it's simply a stub.

sub take_action {
  my ($symbol, $action) = @_;
  
  print "Taking action \"$action\" on stock \"$symbol\" .\n";
}