viewvc.cgi/wopi/make_poll.pl

#!/usr/bin/perl -w
#

use strict;

use XML::Parser;
use Text::Iconv;

# output charset
my $charset='ISO-8859-2';

Text::Iconv->raise_error(0);    # Conversion errors raise exceptions
my $from_utf8 = Text::Iconv->new('UTF8', $charset);
sub x { 
        return $from_utf8->convert($_[0]);
}

$|=1;

my $Usage =<<'End_of_Usage;';
slides [-h] [-d dir] [-mode mode] slide-doc

Convert a slideshow document into html, with a separate html document
for each slide and an index to all of them.

        -h      Print this message and exit

        -w      warn about unrecognized tags

        -d      Use dir as directory into which to write html pages. Defaults
                to basename of supplied doc file.

        -mode   Output mode. Choices are html, html-style. Default is
                html-style.

End_of_Usage;

my @Modes = qw(object pass skip);

my $dir;
my $dowarn = 1;
my $dostyle = 0;

my $pitanje_nr = 0;             # curr. pitanje
my $pitanje_tag = "";           # originalni oblik broja pitanja
my $page_nr = 1;                # prvo pitanje na strani

my $p_suffix="";                # if more than one box per question

my $curr_suffix="";             # trenutni suffix

my @stack_pit;                  # stack pitanja (pitanje, suffix)

my @sql_create = ("id serial",
        "http_referer character varying(500)",
        "remote_addr character varying(15)",
        "user_agent character varying(300)",
        "unesen timestamp DEFAULT now()",
        "member_id int4 NOT NULL"
        );
my @sql_update;
my @last_sql_update;
my @prelast_sql_update;

my @php_addon;                  # php code to add on page header

my ($last_fn,$last_page);

# this is unique prefix for this installation
my $prefix="wopi_";

# this is usename in database
my $db_user="dpavlin";

#------------------------------------------------------------------

sub suck_file {
        my $file = shift @_;
        open(H,$file) || die "can't open '$file': $!";
        my $content;
        while (<H>) { $content .= $_; } ;
        close(H);
        return $content;
}

my $html_header=suck_file("header.html");
my $html_separator=suck_file("separator.html");
my $html_footer=suck_file("footer.html");

#------------------------------------------------------------------

sub php_header {
my ($page_nr,@sql_update) = @_;
my $out='<?
        include("common.inc");
        if (isset($update)) {
                $member_id=id_decode($a);
                ';
$out.=$php_addon[$page_nr-2] if (defined $php_addon[$page_nr-2]);
$out.='
                $sql="update '.$dir.' set '.join(",\n",@sql_update).',
                        do_stranice=\'$PHP_SELF\'
                        where id=$id";
#               print "<pre>$sql</pre>";
                $result=pg_Exec($conn,fix_sql($sql));
        } elseif($do_stranice != $PHP_SELF) {
                Header("Location: $do_uri?a=$a");
                exit;
        }
?>';
return $out;
}

#------------------------------------------------------------------

# first, define some constants
my $common_inc='
$PREFIX="'.$prefix.'";
$DB_USER="'.$db_user.'";
$MEMBERS_DB="'.$prefix.'_members";
';

# then append rest of text

$common_inc.=<<'End_of_common;';

$conn = pg_connect("dbname=$PREFIX$db user=$DB_USER");
$result=pg_Exec($conn,"set datestyle = 'german'");

set_magic_quotes_runtime(1);

// return number of true answers

function fix_checkboxes($var,$nr) {
        for($i=1; $i<=$nr; $i++) {
                if (isset($GLOBALS[$var."_".$i])) {
                        $GLOBALS[$var."_".$i]="true";
                        $nr++;
                } else {
                        $GLOBALS[$var."_".$i]="false";
                }
        }
        return $nr;

}

function checked($var) {
        if ($var == "true" || $var == "t") return 1;
        return 0;
}

function id_encode($id) {
        return md5($id).strtr($id,"1234567890","abcdef1234");
}

function id_decode($eid) {
        $id=substr(strtr($eid,"abcdef1234","1234567890"),32);
        if (md5($id) == substr($eid,0,32)) {
                return $id;
        } else {
                return 0;
        }
}

function fix_sql($sql) {
        $sql=ereg_replace(",([ \t\n\r]*),",",null\\1,",$sql);
        $sql=ereg_replace(",([ \t\n\r]*),",",null\\1,",$sql);
        $sql=ereg_replace(",([ \t\n\r]*),",",null\\1,",$sql);
        $sql=ereg_replace("=([ \t\n\r,]+)","=null\\1",$sql);
        $sql=ereg_replace("=([ \t\n\r,]*)$","=null\\1",$sql);
        return $sql;
}

function get_answer($p) {
        global $conn,$id,$db;
        $result = pg_Exec ($conn,"select $p from $db where id=$id");
        if ($result && pg_numrows($result) > 0) {
                $row=pg_fetch_row($result,0);
                if (isset($row[0]) && $row[0] != "") {
                        $GLOBALS[$p]=$row[0];
                        return $row[0];
                }
        }
        $GLOBALS[$p]=0;
        return 0;
}

function get_answers($p) {
        global $conn,$id,$db;
        $result = pg_Exec ($conn,"select $p from $db where id=$id");
        if ($result && pg_numrows($result) > 0) {
                $row=pg_fetch_array($result,0);
                $pit=split(",",$p);
                while(list($key,$val) = each($row)) {
                        $GLOBALS[$key]=$val;
                }
        }
}
function get_member($pitanja,$uvjet) {
        global $member_id;
        $p_conn = pg_connect("dbname=$MEMBERS_DB user=$DB_USER");
        if ($uvjet == "") $uvjet="true";
        $result=pg_Exec($p_conn,"select id,$pitanja from member
                where $uvjet and id = $member_id");
        $numrows=pg_numrows($result);
        if ($numrows) {
                $row=pg_fetch_array($result,0);
                $pit=split(",",$pitanja);
                while(list($key,$val) = each($row)) {
                        $GLOBALS["member_".$key]=$val;
                }
        }
}

if (isset($a) && !isset($id) && !isset($pid)) {
        global $conn,$db,$do_stranice;
        $pid=id_decode($a);
        $result = pg_Exec ($conn,"select id,do_stranice from $db where member_id=$pid");
        if ($result && pg_numrows($result) > 0) {
                $row=pg_fetch_array($result,0);
                $id=$row[id];
                $do_stranice=$row[do_stranice];
                $do_uri="http://".$SERVER_NAME.":".$SERVER_PORT.$row[do_stranice];
        }
}

End_of_common;

#------------------------------------------------------------------

my $head_php=suck_file("head.php");

#------------------------------------------------------------------

my $html_kraj=suck_file("thanks.html");

#------------------------------------------------------------------

while (defined($ARGV[0]) and $ARGV[0] =~ /^-/) {
  my $opt = shift;

  if ($opt eq '-h') {
    print $Usage;
    exit;
  }
  elsif ($opt eq '-d') {
    $dir = shift;
  }
  elsif ($opt eq '-w') {
    $dowarn = 1;
  }
  elsif ($opt eq '-mode') {
    my $marg = shift;
    if ($marg eq 'html') {
      $dostyle = 0;
    }
    else {
      die "Unrecognized mode: $marg\n$Usage";
    }
  }
  else {
    die "Unrecognized option: $opt\n$Usage";
  }
}  # End of option processing

my $docfile = shift;

die "No docfile provided:\n$Usage" unless defined $docfile;

die "Can't read $docfile" unless -r $docfile;

if (defined $dir) {
  die "$dir isn't a directory" unless -d $dir;
}
else {
  $docfile =~ m!([^/.]+)(?:\.[^/.]*)?$!;
  $dir = $1;
  if (-e $dir) {
    die "$dir exists but isn't a directory"
      unless -d $dir;
  }
  else {
    mkdir $dir, 0755;
  }
}

my $in_slideshow = 0;
my $after_head = 0;

my $Mode = 0;
my $Mode_level = 0;

my $Text;
my $Markedup_Text;
my $Object;
my @Ostack = ();

my $intext = 0;
my $closure;
my @closure_stack = ();

my $style_link = '';

my $index = 'index.html';
my @slidetitle;
my $body;
my $inlist = 0;

my @Titles;

my $header;

my $prolog = "<html><head>\n";
$prolog .= "<!-- Generated by $0 on " . gmtime() . " GMT -->\n";

my $page_number = 0;

my $p = new XML::Parser(ErrorContext => 3,
                        Handlers => {Start => \&starthndl,
                                     End   => \&endhndl,
                                     Char  => \&text});
$p->parsefile($docfile);

#----------------------------------------------------------

# dump last php page....

print "p[$page_nr] ";

open(PAGE, ">$dir/$last_fn") or die "Couldn't open $last_fn for writing:\n$!";
print PAGE php_header($page_nr,@prelast_sql_update);
my $next_fn=sprintf("%02d.php",$page_nr);
$last_page=~s/##NEXTPAGE##/$next_fn/;
print PAGE $last_page;
close(PAGE);

$page_nr++;
open(PAGE, ">$dir/$next_fn") or die "Couldn't open $next_fn for writing:\n$!";
print PAGE php_header($page_nr,@last_sql_update);
print PAGE "$html_header $html_kraj $html_footer";
close(PAGE);

# dump sql structure

open(SQL,">$dir/$dir.sql") || die "$dir.sql: $!";
print SQL "create table poslani ( member_id int4 not null, unesen timestamp default now() );\n";
print SQL "create table $dir (do_stranice text default null, ",join(",\n",@sql_create),");\n";
close(SQL);

# dump common.inc

open(PHP,">$dir/common.inc") || die "common.inc: $!";
print PHP '<? $db="'.$dir.'";';
print PHP $common_inc;
print PHP '?>';
close(PHP);

open(PHP,">$dir/head.php") || die "head.php: $!";
my $max_page = $page_nr + 1;
$head_php=~ s/##MAXPAGE##/$max_page/;
$head_php=~ s/##TEXT##/Ispunili ste %02d%% ankete/;
print PHP $head_php;
close(PHP);

################
## End of main
################

# return unique name of pitanje
sub new_pit {
        my $out="p".$pitanje_nr.$p_suffix;
        $curr_suffix=$p_suffix;
        $p_suffix++;
        return $out;
}

# current pitanje
sub curr_pit {
        return "p".$pitanje_nr.$curr_suffix;
}

sub starthndl {
  my ($xp, $el, %atts) = @_;

#  return unless ($in_slideshow or $el eq 'slideshow');

  unless ($in_slideshow) {
    $in_slideshow = $xp->depth + 1;
    return;
  }

  if ($Mode) {

    if ($Mode eq 'pass') {
      $Markedup_Text .= "\n" . $xp->recognized_string;
    }
    elsif ($Mode eq 'object') {
      push(@Ostack, $Object);

      $Object = {_Atts    => \%atts,
                 _Text    => ''
                };
      bless $Object, "Slideobj::$el";
    }

    # skip does nothing
    return;
  }

  unless ($after_head) {
    if ($el eq 'head') {
      $after_head = 1;
      start_mode($xp, 'object');

      push(@closure_stack, $closure);
      $closure =
        sub {
          my ($xp, $text) = @_;

          unless (defined $text) {
            
            $header = $Object;
          }
        };

      return;
    }

#    die "The head element must be the first thing in the slideshow";
  }


  my $new_closure;

  my $subname = "Slideshow::$el";

  if (defined &$subname) {
    no strict 'refs';

    &$subname($xp, $el, \%atts, \$new_closure);
  }
  else {
    $body .= $xp->recognized_string;
    $new_closure =
      sub {
        my ($xp, $text) = @_;
        
        if (defined $text) {
          $body .= $text;
        }
        else {
          $body .= "</$el>";
        }
      };
  }

  push(@closure_stack, $closure);
  $closure = $new_closure;
}  # End starthndl

sub endhndl {
  my ($xp, $el) = @_;

  return unless $in_slideshow;

  my $lev = $xp->depth;

  if ($lev == $in_slideshow - 1) {
    $in_slideshow = 0;
    $xp->finish;
    return;
  }
  
  if ($Mode_level == $lev) {
    
    if ($Mode eq 'pass') {
      &$closure($xp, $Markedup_Text)
        if (defined $closure);
    }

    $Mode = $Mode_level = 0;
  }

  if ($Mode) {
    if ($Mode eq 'pass') {
      $Markedup_Text .= "</$el>";
    }
    elsif ($Mode eq 'object') {
      my $this = $Object;
      if (2 == keys %$this) {
        $this = $this->{_Text};
      }

      $Object = pop(@Ostack);

      my $slot = $Object->{$el};
      if (defined $slot) {
        if (ref($slot) eq 'ARRAY') {
          push(@$slot, $this);
        }
        else {
          $Object->{$el} = [$slot, $this];
        }
      }
      else {
        $Object->{$el} = $this;
      }
    }

    return;
  }

  &$closure($xp)
    if defined $closure;

  $closure = pop(@closure_stack);
}  # End endhndl

sub text {
  my ($xp, $data) = @_;

  return unless $in_slideshow;

  if ($Mode ) {

    if ($Mode eq 'pass') {
      my $safe = sgml_escape($data);

      $Text .= $safe;
      $Markedup_Text .= $safe;
    }
    elsif ($Mode eq 'object') {
      $Object->{_Text} .= $data
        if $data =~ /\S/;
    }

    return;
  }

  &$closure($xp, sgml_escape($data))
    if (defined $closure);

}  # End text

sub start_mode {
  my ($xp, $mode) = @_;

  if ($mode eq 'pass') {
    $Text = '';
    $Markedup_Text = '';
  }
  elsif ($mode eq 'object') {
    $Object = {_Atts => undef,
               _Text => undef
              };
  }

  $Mode = $mode;
  $Mode_level = $xp->depth;
}  # End start_mode

sub sgml_escape {
  my ($str) = @_;

  $str =~ s/\&/\&amp;/g;
  $str =~ s/</\&lt;/g;
  $str =~ s/>/\&gt;/g;

  $str;
}  # End sgml_escape

sub slidename {
  my ($num) = @_;

  sprintf("slide%03d.html", $num);
}  # End slidename

################################################################

package Slideshow;

sub page {
        package main;

        my ($xp, $el, $attref, $ncref) = @_;

        $$ncref = sub {
                my ($xp, $text) = @_;

                if (! defined $text) {

                        print "p[$page_nr] ";

                        if (defined $last_fn) {
                                # 01.php -> index.php
                                $last_fn="index.php" if ($last_fn eq "01.php");
                                open(PAGE, ">$dir/$last_fn") or die "Couldn't open $last_fn for writing:\n$!";
                                if ($page_nr == 2) {
                                        print PAGE '<?
include("common.inc");
if (isset($do_stranice) && $do_stranice !="") {
        Header("Location: $do_uri?a=$a");
        exit;
}
$member_id=id_decode($a);
$sql="insert into '.$dir.' ( http_referer,remote_addr,user_agent, member_id ) values (\'$HTTP_REFERER\',\'$REMOTE_ADDR\',\'$HTTP_USER_AGENT\',$member_id)";

#       print "<pre>$sql</pre>";
        $result=pg_Exec($conn,fix_sql($sql));
        $lastoid=pg_getlastoid($result);
        $result = pg_Exec($conn,fix_sql("select id from '.$dir.' where oid=$lastoid"));
        $row=pg_fetch_row($result,0);
        $id=$row[0];
?>';

                                } else {
                                        print PAGE php_header($page_nr,@prelast_sql_update);
                                } # last_sql_update


                                my $next_fn=sprintf("%02d.php",$page_nr);
                                $last_page=~s/##NEXTPAGE##/$next_fn/;
                                print PAGE $last_page;
                                close(PAGE);

                        }
                        @prelast_sql_update=@last_sql_update;
                        @last_sql_update=@sql_update;
                        @sql_update = ();
        
                        $last_fn=sprintf("%02d.php",$page_nr);
                        $last_page="$html_header $body $html_footer";
                        # delete vars for next page
                        $page_nr++;
                        $body="";
                }
        }
}  # page

sub nr {
        package main;

        my ($xp, $el, $attref, $ncref) = @_;

        $pitanje_tag="";

        $$ncref = sub {
                my ($xp, $text) = @_;
                if (defined($text)) {
                        $body.=$text;
                        chomp $text;
                        $pitanje_tag .= $text;
                } else {
                        $pitanje_nr = $pitanje_tag;
                        $pitanje_nr =~ s/[^0-9a-zA-Z]//g;
                        print "$pitanje_nr ";
                }
                $p_suffix="";
        };
}  # nr


sub hr {
        $body .= "<br></td></tr>$html_separator<tr><td></td><td><br>";
}

sub br {
        $body .= "<br>\n";
}

sub pit {
        package main;

        my ($xp, $el, $attref, $ncref) = @_;

        $body.="<p>";

        $$ncref = sub {
                my ($xp, $text) = @_;

                if (defined $text) {
                        $body.=x($text);
                } else {
                        $body.="</p>";
                }
        }
}

sub podpit {
        package main;

        my ($xp, $el, $attref, $ncref) = @_;

        $body.='<table width="100%" cellspacing="0" cellpadding="2" border="0">';
        $$ncref = sub {
                my ($xp, $text) = @_;

                if (defined $text) {
                        $body.=x($text);
                } else {
                        $body.="</table>";
                }
        }
}


sub odg {
        package main;

        my ($xp, $el, $attref, $ncref) = @_;

        $body .= "<p>";

        $$ncref = sub {
                my ($xp, $text) = @_;

                if (defined $text) {
                        $body .= x($text);
                } else {
                        $body .= "</p>";
                }
        }
}

sub php {
        package main;
        my ($xp, $el, $attref, $ncref) = @_;

        $body.="<?php\n";

        $$ncref = sub {
                my ($xp, $text) = @_;

                if (defined $text) {
                        $text=~s/ lt / < /g;
                        $text=~s/ le / <= /g;
                        $text=~s/ gt / > /g;
                        $text=~s/ ge / >= /g;
                        $body.=x($text);
                } else {
                        $body.="\n?>\n";
                }
        }
}

sub dropdown {
        package main;

        my ($xp, $el, $attref, $ncref) = @_;

        my @dropdown_data;

        $$ncref = sub {
                my ($xp, $text) = @_;

                if (defined $text) {
                        chomp $text;
                        $text=~s/^\s*//g;
                        $text=~s/^[\d\.\s]+//g;
                        $text=~s/\s*$//g;
                        push @dropdown_data,x($text) if ($text ne "");
                } else {
                        my $opt;
                        my $id=1;
                        my $p=new_pit();
                        $body.="<select name=$p >\n";
                        $body.="<option value=null>-</option>\n";
                        foreach $opt (@dropdown_data) {
                                if (defined($opt) && $opt ne "") {
                                        $body.="<option value=$id>$opt</option>\n";
                                        $id++;
                                }
                        }
                        $body.="</select>\n";

                        push @sql_create,"$p int4";
                        push @sql_update,"$p=\$$p";
                }
        }
}

sub textbox {
        package main;
        my ($xp, $el, $attref, $ncref) = @_;

        $$ncref = sub {
                my ($xp, $text) = @_;
                my $size=$attref->{size};
                $size = 25 if (! defined $size || $size == 0);  # default
                my $p=new_pit();
                $body.="<input type=text name=$p size=".x($size)." >\n";
                push @sql_create,"$p text";
                push @sql_update,"$p='\$$p'";
        }
}

sub radiobuttons_tab {
        package main;
        my ($xp, $el, $attref, $ncref) = @_;

        $$ncref = sub {
                my ($xp, $text) = @_;
                if (! defined $text) {
                        my $nr=$attref->{nr};
                        my $p=new_pit();
                        for (my $i=1; $i<=$nr; $i++) {
                                $body.="<td><input type=radio name=$p value=$i></td> ";
                        }
                        push @sql_create,"$p int4";
                        push @sql_update,"$p=\$$p";
                }
        }
}

sub radiobuttons {
        package main;
        my ($xp, $el, $attref, $ncref) = @_;

        my @radiobuttons_data;

        $$ncref = sub {
                my ($xp, $text) = @_;
                
                if (defined $text) {
                        chomp $text;
                        $text=~s/^\s*//g;
                        $text=~s/^[\d\.\s]+//g;
                        $text=~s/\s*$//g;
                        push @radiobuttons_data,x($text) if ($text ne "");
                } else {
                        my $opt;
                        my $p=new_pit();
                        my $id=1;
                        foreach $opt (@radiobuttons_data) {
                                if (defined($opt) && $opt ne "") {
                                        $body.="<input type=radio name=$p value=$id> $opt<br>\n";
                                        $id++;
                                }
                        }
                        push @sql_create,"$p int4";
                        push @sql_update,"$p=\$$p";
                }
        }
}
sub checkbox {
        package main;
        my ($xp, $el, $attref, $ncref) = @_;

        $$ncref = sub {
                my ($xp, $text) = @_;
                my $p=new_pit();
                $body.="<input type=checkbox name=$p >\n";
                push @sql_create,"$p text";
                push @sql_update,"$p='\$$p'";
        }
}

sub checkboxes {
        package main;

        my ($xp, $el, $attref, $ncref) = @_;

        my @checkboxes_data;

        $$ncref = sub {
                my ($xp, $text) = @_;


                if (defined $text) {
                        chomp $text;
                        $text=~s/^\s*//g;
                        $text=~s/^[\d\.\s]+//g;
                        $text=~s/\s*$//g;
                        push @checkboxes_data,x($text) if ($text ne "");
                } else {
                        my $opt;
                        my $base_p=new_pit();
                        my $id=1;

                        my $before=$attref->{before};
                        my $after=$attref->{after};
                        my $middle=$attref->{middle};
                        if (! $before && ! $after && ! $middle) {
                                $middle="&nbsp;";
                                $after="<br>";
                        }
                        my $hide_description=$attref->{hide_description};

                        foreach $opt (@checkboxes_data) {
                                if (defined($opt) && $opt ne "") {
                                        $p=$base_p."_".$id;
                                        $id++;
                                        $body .= x($before) if ($before);
                                        $body.="<input type=checkbox name=$p>";
                                        $body .= x($middle) if ($middle);
                                        $body .= "$opt" if (! $hide_description);
                                        $body .= x($after) if ($after);
                                        $body.="\n";

                                        push @sql_create,"$p boolean";
                                        push @sql_update,"$p=\$$p";
                                }
                        }
                        $php_addon[$page_nr].="fix_checkboxes($base_p,".($id-1).");";

                }
        }
}

#---------------------------------------------------------------

sub slide {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  my $prev = $page_number ? slidename($page_number) : $index;
  $page_number++;
  my $fn = slidename($page_number);
  my $next = slidename($page_number + 1);

  open(SLIDE, ">$dir/$fn") or die "Couldn't open $fn for writing:\n$!";

  print SLIDE $prolog;

  undef @slidetitle;
  $body = '';
  $inlist = 0;

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined $text) {
        #ignore text at slide toplevel
      }
      else {
        $Titles[$page_number] =  $slidetitle[0];

        print SLIDE "<title>$slidetitle[0]</title>\n";
        print SLIDE $style_link;
        print SLIDE "</head>\n";

        if ($dostyle) {
          print SLIDE "<body>\n";
        }
        else {
          print SLIDE "<body background=\"back.gif\">\n";
        }
      
        my $navbar = "<table class=\"navbar\" width=\"100%\"><tr>\n";
        $navbar .= "<td align=\"left\"><a href=\"$prev\">Previous</td>\n";
        $navbar .= "<td align=\"left\"><a href=\"$index\">Index</td>\n";
        $navbar .= "<td align=\"right\"><a href=\"$next\">Next</td>\n";
        $navbar .= "</table>\n";

        print SLIDE "$navbar<hr>\n";
        if ($dostyle) {
          print SLIDE "<img class=\"logo\" src=\"logo.gif\">\n";
          print SLIDE "<h1 class=\"title\">$slidetitle[1]</h1>\n";
        }
        else {
          print SLIDE "<table width=\"100%\"><tr><td>\n";
          print SLIDE "<img src=\"logo.gif\">\n";
          print SLIDE "<td align=\"left\">";
          print SLIDE "<h1>";
          print SLIDE "<font size=\"7\" color=\"maroon\">$slidetitle[1]";
          print SLIDE "</font></h1>\n";
          print SLIDE "<tr><td colspan=\"2\">\n";
          print SLIDE "<table width=\"80%\"><tr><td>\n";
          print SLIDE "<font size=\"+2\">\n";
        }
        print SLIDE $body;

        if ($inlist) {
          print SLIDE "\n</$inlist>\n";
        }

        unless ($dostyle) {
          print SLIDE "\n</font>\n";
          print SLIDE "\n</table></table>\n";
        }

        print SLIDE "\n<hr>\n$navbar";
        print SLIDE "</body>\n</html>\n";
        close(SLIDE);
      }
    };
}  # End slide

sub title {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  if ($xp->current_element eq 'slide') {
    start_mode($xp, 'pass');

    $$ncref =
      sub {
        $slidetitle[0] = $Text;
        $slidetitle[1] = $Markedup_Text;
      };
  }
}  # End title

sub point {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  if ($inlist and $inlist ne 'ul') {
    $body .= "\n</$inlist>\n";
    $inlist = 0;
  }

  unless ($inlist) {
    $body .= "\n<ul>\n";
  }

  $inlist = 0;

  if ($dostyle) {
    $body .= "\n<li><div class=\"point\">";
  }
  else {
    $body .= "\n<li>";
  }

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined $text) {
        $text =~ s/\s+/ /g;
        $body .= $text;
      }
      else {
        if ($dostyle) {
          $body .= "</div></li>";
        }
        $body .= "\n</$inlist>\n"
          if $inlist;
        $inlist = 'ul';
      }
    };

}  # End point

sub item {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  if ($inlist and $inlist ne 'ul') {
    $body .= "\n</$inlist>\n";
    $inlist = 0;
  }

  unless ($inlist) {
    $body .= "\n<ul>\n";
  }

  $inlist = 0;

  if ($dostyle) {
    $body .= "\n<li><div class=\"item\">";
  }
  else {
    $body .= "\n<li><font face=\"monospace\">";
  }

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined $text) {
        $text =~ s/\s+/ /g;
        $body .= $text;
      }
      else {
        if ($dostyle) {
          $body .= "</div></li>";
        }
        else {
          $body .= "</font>";
        }
        $body .= "\n</$inlist>\n"
          if $inlist;
        $inlist = 'ul';
      }
    };
}  # End item

sub def {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  if ($inlist and $inlist ne 'dl') {
    $body .= "\n</$inlist>\n";
    $inlist = 0;
  }

  unless ($inlist) {
    $body .= "\n<dl>\n";
  }

  $inlist = 0;

  if ($dostyle) {
    $body .= "<dt><span class=\"defterm\">";
    $body .=  $attref->{term} ."</span></dt>\n";
    $body .= "<dd><div class=\"def\">\n";
  }
  else {
    $body .= "<dt><font face=\"monospace\" color=\"maroon\" style=\"bold\">";
    $body .= $attref->{term} . "</font></dt>\n";
    $body .= "<dd>";
  }

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined $text) {
        $text =~ s/\s+/ /g;
        $body .= $text;
      }
      else {
        if ($dostyle) {
          $body .= "</div></dd>\n";
        }
        $body .= "\n</$inlist>\n"
          if $inlist;
        $inlist = 'dl';
      }
    };
}  # End def

sub eg {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  if ($dostyle) {
    $body .= "<div class=\"eg\"><pre>";
  }
  else {
    $body .= "<table bgcolor=\"tan\" width=\"70%\"><tr><td>\n";
    $body .= "<font size=\"+1\"><pre>";
  }

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined $text) {
        $body .= $text;
      }
      else {
        if ($dostyle) {
          $body .= "</pre></div>\n";
        }
        else {
          $body .= "</pre></font></td></tr></table>\n"
        }
      }
    };
}  # End eg

sub key {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  if ($dostyle) {
    $body .= "<span class=\"key\">";
  }
  else {
    $body .= "<font face=\"monospace\" color=\"navy\">";
  }

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined $text) {
        $body .= $text;
      }
      else {
        if ($dostyle) {
          $body .= "</span>";
        }
        else {
          $body .= "</font>";
        }
      }
    };
}  # End key

sub abstract {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  if ($dostyle) {
    $body .= "<span class=\"abstract\">";
  }
  else {
    $body .= "<font color=\"green\">";
  }

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined $text) {
        $body .= $text;
      }
      else {
        if ($dostyle) {
          $body .= "</span>";
        }
        else {
          $body .= "</font>";
        }
      }
    };
}  # End abstract

sub screen {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  if ($dostyle) {
    $body .= "<pre class=\"screen\">\n";
  }
  else {
    $body .= "<table bgcolor=\"white\" border=\"1\" width=\"70%\"><tr><td>\n";
    $body .= "<font size=\"+1\"><pre>";
  }

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined $text) {
        $body .= $text;
      }
      else {
        if ($dostyle) {
          $body .= "</pre>\n";
        }
        else {
          $body .= "</pre></td></tr></table>\n";
        }
      }
    };
}  # End screen

sub input {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  if ($dostyle) {
    $body .= "<span class=\"input\">";
  }
  else {
    $body .= "<b>";
  }

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined $text) {
        $body .= $text;
      }
      else {
        if ($dostyle) {
          $body .= "</span>";
        }
        else {
          $body .= "</b>";
        }
      }
    };
}  # End input

sub group {
}  # End group

sub text {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  $body .= "<p>\n";

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined $text) {
        $text =~ s/\s+/ /g;
        $body .= $text;
      }
    };
}  # End text

sub book {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  start_mode($xp, 'object');

  $$ncref =
    sub {
      my ($xp) = @_;

      if ($dostyle) {
        $body .= "<span class=\"booktitle\">";
        $body .= sgml_escape($Object->{title});
        $body .= "</span>\n";
      }
      else {
        $body .= "<cite>" . sgml_escape($Object->{title}) . "</cite>\n";
      }
    };
}

sub aside {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  if ($dostyle) {
    $body .= "<span class=\"aside\">[";
  }
  else {
    $body .= "<em>[";
  }
  

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined $text) {
        $body .= $text;
      }
      else {
        if ($dostyle) {
          $body .= "]</span>\n";
        }
        else {
          $body .= "]</em>";
        }
      }
    };
}

sub url {
  package main;

  my ($xp, $el, $attref, $ncref) = @_;

  my $url='';

  $$ncref =
    sub {
      my ($xp, $text) = @_;

      if (defined($text)) {
        $url .= $text;
      }
      else {
        $body .= "<a href=\"$url\">$url</a>";
      }
    }
}

## Local Variables: ##
## mode:perl ##
## End: ##