#
# Wiki Editor Daemon Object wikiEditDaemonObject.pm
# (c) 2002 Simon Clift
# Licensed under the Gnu GPL
#
# Using the parameters specified, this object "wraps" the contents of the
# working directory and maintains it.  The commands understood by the
# wikiEditDaemon map directly to messages in this object.
#
# Hash values in this object are:
#
#   $self->{ 'parm' }           Parameter hash.
#   $self->{ 'ua' }             LWP::UserAgent object.
#   $self->{ 'editDirectory' }  Path of the editing directory.
#   $self->{ 'log' }            Log file IO::File object.
#   $self->{ 'logStart' }       Date string on which the log was started.
#   $self->{ 'in' }             Input pipe IO::File object.
#   $self->{ 'wikiURL'}         URL of the Wiki.
#   $self->{ 'wikiWeb'}         Default web to access (initially 'Main')
#   $self->{ 'wikiNetLoc' }     Net location of the Wiki.
#

package wikiEditDaemonObject;

# Some defaults which unlikely to be different elsewhere.

use English;
use strict;

use POSIX;
use IO::File;

use URI;
use LWP::UserAgent;

my $viewCmd = 'view';
my $editCmd = 'edit';
my $saveCmd = 'save';
my $divider = '<!--- Do not remove this line: ' 
            . 'Form Fields can be edited below --->';

#----------------------------------------------------------------------
#
sub new
#
# A parameter hash and a user agent object are required.  Basic setup is
# performed based on the parameter hash.
#
{
    my $class = shift;
    my $self  = {};
    bless $self, $class;            # Standard genuflection

    my $parmHash = shift;
    my $ua = shift;

    # Deal with the parameters hash.

    foreach my $parm (  'baseDirectory', 'editDirectory',
                        'pipeName', 'logFileName' )
    {
        if ( defined( $parmHash->{ $parm } ) )
        {
            $self->{ 'parm' }->{ $parm } = $parmHash->{ $parm };
        }
        else
        {
            $self->{ 'parm' }->{ $parm } = 
                                        wikiEditDaemonObject::default{ $parm };
        };
    };

    $self->{ 'ua' } = $ua;

    # Open/create the base directory.  Initialise a log file.  Open/create the
    # edit directory.

    eval
    {
        $self->setUpDirectory( $self->{ 'parm' }->{ 'baseDirectory' } );
        $self->setUpLogFile();
        $self->setUpEditDirectory();
        $self->setUpInputPipe();
    };

    if ( $EVAL_ERROR )
    {
        die $EVAL_ERROR
          . "Initialisation of the wikiEditDaemonObject failed.\n"
          . "   In wikiEditDaemonObject->new\n";
    };

    return $self;
};

#----------------------------------------------------------------------
#
sub setUpDirectory
#
# Set up a the working directory.  The old one is never removed.
#
{
    my $self = shift;
    my $baseDirectory = shift;

    if ( not ( -d $baseDirectory ) )
    {
        my $success = mkdir $baseDirectory, 0700;

        if ( ! $success )
        {
            die "Unable to create the working directory.\n"
              . "   Name: " . $baseDirectory . "\n"
              . "   In wikiEditDaemonObject->setUpDirectory\n";
        };
    };

    chdir $baseDirectory;
};

#----------------------------------------------------------------------
#
sub setUpEditDirectory
#
# A new edit directory causes a new directory under the base directory to be
# created.  all open files to be moved there, and the old directory will be
# left with its old contents.
#
{
    my $self = shift;

    $self->{ 'editDirectory' } = $self->{ 'parm' }->{ 'baseDirectory' }
                         . '/' . $self->{ 'parm' }->{ 'editDirectory' };

    if ( not ( -d $self->{ 'editDirectory' } ) )
    {
        my $success = mkdir $self->{ 'editDirectory' }, 0700;

        if ( ! $success )
        {
            die "Unable to create the editing directory.\n"
              . "   Name: " . $self->{ 'editDirectory' } . "\n"
              . "   In wikiEditDaemonObject->setUpEditDirectory\n";
        };
    };
};

#----------------------------------------------------------------------
#
sub setUpLogFile
#
# If a log file is already open, we close it.  A new log file is opened
# associated with a given date.  After a date roll-over we shall start a new
# log file.
#
{
    my $self = shift;

    $self->closeLogFile()                   if ( defined( $self->{ 'log' } ) );

    my $logFileName =       $self->{ 'parm' }->{ 'baseDirectory' }
                    . '/' . $self->{ 'parm' }->{ 'logFileName'   };

    if ( -e $logFileName )
    {
        my $dts =  POSIX::strftime( "_%Y%m%d_%H%M%S", localtime );
        rename $logFileName, $logFileName . $dts;
    };

    $self->{ 'log' } = new IO::File( ">" . $logFileName )
        or 
        die "Unable to open the log file.\n"
          . "   File: $logFileName\n"
          . "   In wikiEditDaemonObject->setUpLogFile\n";

    $self->{ 'log' }->autoflush( 1 );

    $self->{ 'logStart' } = POSIX::strftime( "%Y%m%d", localtime );

    chmod 0600, $logFileName;

    $self->writeLogHeader();
};


#----------------------------------------------------------------------
#
sub setUpInputPipe
#
# Create the input pipe.  A FIFO is used here so that an editor can simply
# write a line to it as if it were a file.  Sockets could be used to, in
# the Unix name space, but this would make interfacing with editors harder.
#
{
    my $self = shift;

    # Note that the system return value is backwards, so we && not ||

    my $pipeNode =       $self->{ 'parm' }->{ 'baseDirectory' }
                 . '/' . $self->{ 'parm' }->{ 'pipeName' };

    unlink $pipeNode            if ( ( -p $pipeNode ) or ( -e $pipeNode ) );

    if  (    system('mknod',  $pipeNode, 'p')
          && system('mkfifo', $pipeNode) )
    {
        die "Could not set up the input FIFO.\n"
          . "   mk{nod,fifo} $pipeNode failed.\n"
          . "   In wikiEditDaemonObject->setUpInputPipe\n";
    };

    chmod 0600, $pipeNode;

    $self->{ 'in' } = new IO::File;

};

#----------------------------------------------------------------------
#
sub closeInputPipe
#
# The input pipe is closed and removed.
#
{
    my $self = shift;

    my $pipeNode =       $self->{ 'parm' }->{ 'baseDirectory' }
                 . '/' . $self->{ 'parm' }->{ 'pipeName' };

    unlink $pipeNode;

    undef $self->{ 'in' };
};

#----------------------------------------------------------------------
#
sub loop
#
# Wait for incoming commands and process them.  We'll put a message in the log
# every 10 minutes just as a heartbeat.
#
{
    my $self = shift;

    my $pipeNode =       $self->{ 'parm' }->{ 'baseDirectory' }
                 . '/' . $self->{ 'parm' }->{ 'pipeName' };

    # Loop till we get a 'quit'

    MAINLOOP: while (1)
    {
        my @msgArr;

        eval
        {
            $SIG{ ALRM } = sub { die "Timeout"; };

            alarm( 600 );

            # This pipe will block until there is a writer, but that's OK.

            $self->{ 'in' }->open( "< " . $pipeNode );

            @msgArr = $self->{ 'in' }->getlines();

            $self->{ 'in' }->close();

            alarm (0)
        };

        # If we do something other than time out we'll panic, write that to the
        # log, and try to shut down gracefully.

        if ( $EVAL_ERROR )
        {
            if ( $EVAL_ERROR !~ "^Timeout" )
            {
                my $err = "ERROR:\n" . $EVAL_ERROR
                        . "Unable to continue in wikiEditDaemonObject->loop\n";
                $self->writeToLog( $err );
                $self->quit();
                die $err;
            }
            else
            {
                $self->writeToLog(POSIX::strftime("%H:%M and all is well.\n",
                                                  localtime ));
            };
        };

        # Usually there will be just one message in the array

        foreach my $msg ( @msgArr )
        {
            # Parse the line, taking the first parameter as the command to be
            # executed and passing the rest of the parameters in an array.

            my @parmArr = split ' ', $msg;

            my $cmd = shift @parmArr;

            eval
            {
                if ( $cmd ne 'authenticate' )
                {
                    $self->writeToLog( $msg );
                }
                else
                {
                    # Obscure the password
                    $self->writeToLog( $cmd .' '. $parmArr[0] . " --------\n" );
                };

                $self->$cmd( \@parmArr );
            };

            if ( $EVAL_ERROR )
            {
                my $err = "ERROR:\n" . $EVAL_ERROR
                        . "Unable to process the command.\n"
                        . "   In wikiEditDaemonObject->loop\n";
                $self->writeToLog( $err );
            };

            if ( $cmd eq "quit" )
            {
                last MAINLOOP;
            };
        };
    };
};

#----------------------------------------------------------------------
#
sub quit
#
# Close all files, remove the input pipe, move the log file to a new name and
# shut down.
#
{
    my $self = shift;

    $self->closeInputPipe();
    $self->closeLogFile();
};

#----------------------------------------------------------------------
#
sub configure
#
# Take a configuration command.  At this point we just record them.  They become active only when an edit or read command is given.
# create the new directory.
#
{
    my $self  = shift;
    my $parms = shift;

    if ( $parms->[0] eq 'wikiURL' )
    {
        if ( scalar( @{ $parms } ) == 2 )
        {
            $self->{ 'wikiURL'    } = $parms->[1];
        }
        else
        {
            die "configure wikiURL must have one " 
              . "parameter and did not.\n";
        };

        if ( not defined( $self->{ 'wikiWeb' } ) )
        {
            $self->{ 'wikiWeb' } = 'Main';
        };
    };
};

#----------------------------------------------------------------------
#
sub authenticate
#
# A user name and password are stored to the user agent.
#
{
    my $self  = shift;
    my $parms = shift;

    if ( not defined( $self->{ 'wikiURL' } ) )
    {
        die "Authentication can only be done after the wiki URL is set. \n"
          . "   in wikiEditDaemonObject->authenticate\n";
    };

    my $uri = URI->new( $self->{ 'wikiURL' } );
    $self->{ 'wikiNetLoc' } = $uri->host_port;

    $self->{ 'ua' }->credentials( $self->{ 'wikiNetLoc' }, 'ByPassword',
                                  $parms->[0], $parms->[1] );
};

#----------------------------------------------------------------------
#
sub getWebAndPage
#
# Given a parameter this returns the web and page, setting the web name to the
# default (either 'Main' or the last used) if it is not present, and setting
# the default to the last used when it is present.
#
{
    my $self = shift;
    my $page = shift;

    my $web = $self->{ 'wikiWeb' };

    # Strip a leading path, just in case one got in
    if ( $page =~ /\// )
    {
        $page =~ /\/([\w\.]+)$/;
        $page = $1;

        $self->writeToLog( "We think the user means $page" );
    };

    if ( $page =~ /(\w+)\.(\w+)/ )
    {
        $web  = $1;
        $page = $2;

        $self->{ 'wikiWeb' } = $web;
    };

    return ( $web, $page );
};

#----------------------------------------------------------------------
#
sub read
#
# The wiki page in question is only copied over, and left with the write
# permissions off.
#
{
    my $self   = shift;
    my $parms  = shift;
    my $isEdit = shift;

    # We might be editing.

    $isEdit = 0             if ( not defined( $isEdit ) );

    my ( $web, $page ) = $self->getWebAndPage( $parms->[0] );

    my ( $url, $response );

    # Use the simplest possible method

    if ( $isEdit )
    {
        $url = $self->{ 'wikiURL' } 
             . '/' . $editCmd . '/' . $web . '/' . $page
             . '?skin=minimal';

        $response = $self->{ 'ua' }->post( $url, { 'skin' => 'minimal',
                                                   'raw'  => 1          } );
    }
    else
    {
        $url = $self->{ 'wikiURL' } 
             . '/' . $viewCmd . '/' . $web . '/' . $page;

        $response = $self->{ 'ua' }->post( $url, { 'skin' => 'minimal',
                                                   'raw'  => 1         } );
    };

    if ( not defined( $response ) )
    {
        die "Unable to retrieve $web.$page\n"
          . "   from $self->{ 'wikiURL' }\n"
          . "   in wikiEditDaemonObject->read\n";
    };

    if ( not $response->is_success() )
    {
		my $msg = "   Please refer to the HTML response codes " . 
				  "on the web for more information.";

	    if ( $response->code() == 400 )
		{
			$msg = "   Did you supply a URL yet?"
		};

	    if ( $response->code() == 401 )
		{
			$msg = "   Did you log in yet?  " 
				 . "Maybe your user name/password are incorrect."
		};

        die "Unable to retrieve $web.$page\n"
          . "   from $self->{ 'wikiURL' }\n"
          . "   Response code: " . $response->status_line . "\n"
		  . $msg . "\n"
          . "   in wikiEditDaemonObject->read\n";
    };

    # Clean up the text, in Unix it gets extra carriage returns at the end.
    # Wiki also tries to be a little too helpful and escape our HTML-sensitive
    # bits.

    my $fullText = $response->content;

    $fullText =~ s/\r$//mg;
    $fullText =~ s/\&gt;/\>/mg;
    $fullText =~ s/\&lt;/\</mg;
    $fullText =~ s/\&amp;/\&/mg;

    # Clean up the form

    my ( $text, $form ) = split /$divider/im, $fullText;

    my @formLines = split "\n", $form;

    my $newFormLines;

    foreach my $line ( @formLines )
    {
        next if ( $line =~ /submitChangeForm/ );

        if ( $line =~ /name="(\w+)"/ )
        {
            my $variable = $1;

            if ( $line =~ /value="(.+?)"/ )
            {
                my $value = $1;

                $newFormLines .= "$variable=$value\n";
            };
        };
    };
    
    $fullText = $text . $divider . "\n" . $newFormLines;

    # Save the file in read-only mode.

    my $savePath = $self->{ 'editDirectory' } . '/' . $web . '.' . $page;

    chmod 0600, $savePath                   if ( -e $savePath );

    open SAVE, '>' . $savePath;
    print SAVE $fullText;
    close SAVE;

    chmod 0600, $savePath               if (     $isEdit );
    chmod 0400, $savePath               if ( not $isEdit );

    $self->writeToLog(   "Opened $web.$page in " 
                       . ( ( $isEdit ) ? 'edit' : 'read-only' )
                       . " mode\n" );
};


#----------------------------------------------------------------------
#
sub edit
#
# The wiki page in question is copied over and locked on the Wiki for editing.
# The work is done by the read method above
#
{
    my $self   = shift;
    my $parms  = shift;

    eval
    {
        $self->read( $parms, 1 );
    };

    if ( $EVAL_ERROR )
    {
        die $EVAL_ERROR
          . "Called from wikiEditDaemonObject->edit\n";
    };
};

#----------------------------------------------------------------------
#
sub save
#
# The wiki page is saved back to the web and the lock released.  This level
# handles the 'save ALL' directive.
#
{
    my $self  = shift;
    my $parms = shift;

    if ( $parms->[0] eq 'ALL' )
    {
        opendir( EDITDIR, $self->{ 'editDirectory' } );
        my @saveFiles = grep { /^[A-Z]\w+\.[A-Z]\w+$/ } readdir( EDITDIR );
        closedir( EDITDIR );

        foreach my $save ( @saveFiles )
        {
            if ( -w $self->{ 'editDirectory' } . '/' . $save )
            {
                eval
                {
                    $self->writeToLog( "Saving $save" );
                    $self->saveWebAndPage( $save );
                };

                if ( $EVAL_ERROR )
                {
                    die $EVAL_ERROR
                      . "During save ALL operation.\n"
                      . "   In wikiEditDaemonObject->save\n";
                };
            };
        };
    }
    else
    {
        $self->saveWebAndPage( $parms->[0] );
    };
};

#----------------------------------------------------------------------
#
sub saveWebAndPage
#
# This level does the actual wiki page save with lock release.  A read-only
# copy of the page is retained.  We send the full text back and the form values
# in the query parameters for the POST operation.
#
{
    my $self  = shift;
    my $page  = shift;

    my $web;

    ( $web, $page ) = $self->getWebAndPage( $page );

    # Get the page text if it exists

    my $pagePath = $self->{ 'editDirectory' } . '/' . $web . '.' . $page;
    
    if ( not ( -e $pagePath ) )
    {
        die "It seems that $web.$page hasn't been retreieved.\n"
          . "   The local file does not exist.\n"
          . "   In wikiEditDaemonObject->saveWebAndPage\n";
    };

    if ( not ( -w $pagePath ) )
    {
        die "It seems that $web.$page isn't open for editing.\n"
          . "   In wikiEditDaemonObject->saveWebAndPage\n";
    };

    open PAGE, "< " . $pagePath
                            or
                            die "Unable to open $web.$page for reading.\n"
                              . "   Path $pagePath"
                              . "   In wikiEditDaemonObject->saveWebAndPage\n";
    my $fullText = join "", <PAGE>;
    close PAGE;

    # Extract the text area and the form values.

    my ( $text, $form ) = split /$divider/im, $fullText;

    # Parse out the form values.

    my %hashToSubmit;

    my @formArr = split "\n", $form;

    foreach my $formLine ( @formArr )
    {
        if ( $formLine =~ /(\w+)=(.*)/ )
        {
            $hashToSubmit{ $1 } = $2;
        };
    };

    # Add the text and submission values.

    $hashToSubmit{ 'text'   } = $text;
    $hashToSubmit{ 'unlock' } = 1;

    # Do the submission

    my $url = $self->{ 'wikiURL' } . '/' . $saveCmd . '/' . $web . '/' . $page;

    my $response = $self->{ 'ua' }->post( $url, \%hashToSubmit );

    # Normal response on a save is to redirect, so we get a code 302

    if ( not $response->code() == 302)
    {
        die "Unable to save $web.$page\n"
          . "   from $self->{ 'wikiURL' }\n"
          . "   Response code: " . $response->status_line . "\n"
          . "   in wikiEditDaemonObject->save\n";
    };

    # Clean out the file

    unlink $pagePath;
};

#----------------------------------------------------------------------
#
sub writeToLog
#
# The message is written to the log file.  If the log file is associated with a
# previous date then a new log file is created and a header is written.
#
{
    my $self = shift;
    my $msg = shift;

    my $today = POSIX::strftime( "%Y%m%d", localtime );

    if ( $today ne $self->{ 'logStart' } or not defined( $self->{ 'log' } ) )
    {
        $self->{ 'logStart' } = $today;     # Important or it loops...
        $self->setUpLogFile();
    };

    my $dateStamp = POSIX::strftime( "%Y-%m-%d %H:%M:%S", localtime );

    $self->{ 'log' }->print( $dateStamp . "\n" . $msg );

    if ( $msg !~ /\n$/ ) { $self->{ 'log' }->print( "\n" ); };
};

#----------------------------------------------------------------------
#
sub writeLogHeader
#
# This is a log header with all of the parameters so that we can read it back
# for a "resume" command.
#
{
    my $self = shift;
    
    my $header = <<EOHDR;
Log Opened
configure baseDirectory $self->{ 'parm' }->{ 'baseDirectory' }
configure editDirectory $self->{ 'parm' }->{ 'editDirectory' }
configure pipeName $self->{ 'parm' }->{ 'pipeName' }
configure logFileName $self->{ 'parm' }->{ 'logFileName' }
PID = $PID
EOHDR

    $self->writeToLog( $header );
};

#----------------------------------------------------------------------
#
sub closeLogFile
#
# This message notes the close of a log file and closes the file.
#
{
    my $self = shift;

    $self->writeToLog( "WikiEditorService has been shut down.\n" );

    $self->{ 'log' }->close();

    undef $self->{ 'log' };
};


1;