<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Posting::Write;

################################################################################
#                                                                              #
# File:        shared/Posting/Write.pm                                         #
#                                                                              #
# Authors:     André Malo &lt;nd@o3media.de&gt;, 2001-04-08                          #
#                                                                              #
# Description: Save a posting                                                  #
#                                                                              #
################################################################################

use strict;
use vars qw(
  %error
  @EXPORT
  $VERSION
);

use Encode::Plain; $Encode::Plain::utf8 = 1;
use Encode::Posting;
use Lock qw(
  :WRITE
  release_file
);
use Posting::_lib qw(
  get_message_node
  get_message_header
  create_forum_xml_string
  create_new_thread
  create_message
  save_file
  parse_xml_file
  KEEP_DELETED
);

use XML::DOM;

%error = (
  threadWrite =&gt; '1 could not write thread file',
  forumWrite  =&gt; '2 could not write forum file',
  threadFile  =&gt; '3 could not load thread file',
  noParent    =&gt; '4 could not find parent message'
);

################################################################################
#
# Version check
#
$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

################################################################################
#
# Export
#
use base qw(Exporter);
@EXPORT = qw(
  write_new_thread
  write_reply_posting
);

### sub write_new_thread ($) ###################################################
#
# save a posting and update the forum main file
#
# Params: $param - hashreference
#                  (see doc for details)
#
# Return: (0 or error, thread-xml, new mid)
#
sub write_new_thread ($) {
  my $param = shift;
  my $thread;
  my $mid   = 'm'.($param -&gt; {lastMessage} + 1);
  my $tid   = 't'.($param -&gt; {lastThread} + 1);

  # define the params needed for a new thread
  #
  my $pars = {
    msg      =&gt; $mid,
    ip       =&gt; $param -&gt; {ip},
    name     =&gt; defined $param -&gt; {author}   ? $param -&gt; {author}   : '',
    email    =&gt; defined $param -&gt; {email}    ? $param -&gt; {email}    : '',
    home     =&gt; defined $param -&gt; {homepage} ? $param -&gt; {homepage} : '',
    image    =&gt; defined $param -&gt; {image}    ? $param -&gt; {image}    : '',
    category =&gt; defined $param -&gt; {category} ? $param -&gt; {category} : '',
    subject  =&gt; defined $param -&gt; {subject}  ? $param -&gt; {subject}  : '',
    body     =&gt; encoded_body(
      \($param -&gt; {body}),
      { quoteChars =&gt; $param -&gt; {quoteChars},
        messages   =&gt; $param -&gt; {messages},
        base_uri   =&gt; $param -&gt; {base_uri}
      }
    ),
    time     =&gt; $param -&gt; {time},
    dtd      =&gt; $param -&gt; {dtd},
    thread   =&gt; $tid
  };

  # create new thread and save it to disk
  #
  $thread = create_new_thread ($pars);
  save_file ($param -&gt; {messagePath}.$tid.'.xml',\($thread -&gt; toString)) or return $error{threadWrite};

  # update forum main file
  #
  $param
    -&gt; {parsedThreads}
    -&gt; {$param -&gt; {lastThread} + 1} = [
        { mid     =&gt; $param -&gt; {lastMessage} + 1,
          unid    =&gt; $param -&gt; {uniqueID},
          name    =&gt; plain($pars -&gt; {name}),
          cat     =&gt; plain($pars -&gt; {category}),
          subject =&gt; plain($pars -&gt; {subject}),
          time    =&gt; plain($pars -&gt; {time}),
          level   =&gt; 0,
        }
       ];

  my $forum = create_forum_xml_string (
    $param -&gt; {parsedThreads},
    { dtd         =&gt; $pars -&gt; {dtd},
      lastMessage =&gt; $mid,
      lastThread  =&gt; $tid
    }
  );

  save_file ($param -&gt; {forumFile}, $forum) or return $error{forumWrite};
  release_file ($param -&gt; {messagePath}.$tid.'.xml');
  return (0, $thread, $mid, $tid);
}

### sub write_reply_posting ($) ################################################
#
# save a reply and update the forum main file
#
# Params: $param - hashreference
#                  (see doc for details)
#
# Return: (0 or error, thread-xml, new mid)
#
sub write_reply_posting ($) {
  my $param = shift;
  my $thread;
  my $mid   = 'm'.($param -&gt; {lastMessage} + 1);
  my $tid   = 't'.($param -&gt; {thread});

  my $tfile = $param -&gt; {messagePath}.$tid.'.xml';

  unless (write_lock_file ($tfile)) {
    violent_unlock_file ($tfile);
    return $error{threadFile};
  }

  else {
    my $xml = parse_xml_file ($tfile);

    unless ($xml) {
      violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
      return $error{threadFile};
    }

    my $mnode = get_message_node ($xml, $tid, 'm'.$param -&gt; {parentMessage});

    unless (defined $mnode) {
      violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
      return $error{noParent};
    }

    my $pars = {
      msg      =&gt; $mid,
      ip       =&gt; $param -&gt; {ip},
      name     =&gt; defined $param -&gt; {author}   ? $param -&gt; {author}   :'',
      email    =&gt; defined $param -&gt; {email}    ? $param -&gt; {email}    :'',
      home     =&gt; defined $param -&gt; {homepage} ? $param -&gt; {homepage} :'',
      image    =&gt; defined $param -&gt; {image}    ? $param -&gt; {image}    :'',
      category =&gt; defined $param -&gt; {category} ? $param -&gt; {category} :'',
      subject  =&gt; defined $param -&gt; {subject}  ? $param -&gt; {subject}  :'',
      time     =&gt; $param -&gt; {time},
    };

    my $message = create_message ($xml, $pars);

    $mnode -&gt; appendChild ($message);

    my $mcontent = $xml -&gt; createElement ('MessageContent');
    $mcontent -&gt; setAttribute ('mid' =&gt; $mid);
    $mcontent -&gt; appendChild (
      $xml -&gt; createCDATASection (
        ${encoded_body(
          \($param -&gt; {body}),
          { quoteChars =&gt; $param -&gt; {quoteChars},
            messages   =&gt; $param -&gt; {messages},
            base_uri   =&gt; $param -&gt; {base_uri}
          }
        )}
      )
    );

    my $content = $xml -&gt; getElementsByTagName ('ContentList', 1) -&gt; item (0);
       $content -&gt; appendChild ($mcontent);

    # save thread file
    #
    unless (save_file ($tfile, \($xml -&gt; toString))) {
      violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
      return $error{threadWrite};
    }

    violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));

    $thread = $xml;

    # add message to thread tree
    # ATTENTION: don't use the tree for visual output after this operation
    #
    my $i=1;
    for (@{$param -&gt; {parsedThreads} -&gt; {$param -&gt; {thread}}}) {
      if ($_ -&gt; {mid} == $param -&gt; {parentMessage}) {
        splice @{
          $param -&gt; {parsedThreads} -&gt; {$param -&gt; {thread}}},$i, 0,
          { mid     =&gt; $param -&gt; {lastMessage} + 1,
            unid    =&gt; plain ($param -&gt; {uniqueID}),
            name    =&gt; plain ($pars -&gt; {name}),
            cat     =&gt; plain ($pars -&gt; {category}),
            subject =&gt; plain ($pars -&gt; {subject}),
            level   =&gt; $_ -&gt; {level} + 1,
            time    =&gt; plain ($pars -&gt; {time})
          };
        last;
      }
      $i++;
    }

    # create &amp; save forum main file
    #
    my $forum = create_forum_xml_string (
      $param -&gt; {parsedThreads},
      { dtd         =&gt; $param -&gt; {dtd},
        lastMessage =&gt; $mid,
        lastThread  =&gt; 't'.$param -&gt; {lastThread}
      }
    );

    save_file ($param -&gt; {forumFile}, $forum) or return $error{forumWrite};
  }

  return (0, $thread, $mid, $tid);
}

# keep 'require' happy
#
1;

#
#
### end of Posting::Write ######################################################</pre></body></html>