Data File getting set to an empty file

[Nigel Peck]

Hi all,

I have a (possible) problem with a script that records the number of page
views for various pages on a site (full script below).

Every so often (60 days or more) the data file (data.xml) loses all it's
data and is still there but empty.

Any suggestions greatly appreciated.

Cheers,
Nigel

-=-=-=-=-=Script Follows=-=-=-=-=-

use strict;
use XML::LibXML;
use CGI;
use IO::AtomicFile;

sub build_dom (\$\$\$);
sub commit_changes ($$\$);
sub error ($);

my $query = new CGI;
$CGI::DISABLE_UPLOADS = 1;

print "Content-type: text/html\n\n";

my $lasterror;
my $data_file = "/home/sebs/pageviews/data.xml";
my $error_file = "/home/sebs/pageviews/errors.txt";

my $location = $query->param("location") ||
        error ('Required variable location was not sent');

my $data;

build_dom($data, $data_file, $lasterror)
        || error($lasterror);

my $views;
my $node = (($data->findnodes('//[EMAIL PROTECTED]"' . $location .
'"]'))?($data->findnodes('//[EMAIL PROTECTED]"' . $location . '"]')->[0]):'');

if ( not $node ) {
# It's a new page, not seen before, create a page element for it
        $node = XML::LibXML::Element->new('page');
        $node->setAttribute('location', $location);
        $node->setAttribute('views', 0);
        $node->setAttribute('starttime', time);
        $data->getDocumentElement->appendChild($node);
}

my $views = $node->getAttribute('views');

if ( $query->param("average") == 1 ) {
# Send the average and die if average was set
        my $starttime = $node->getAttribute('starttime');
        my $timediff = time - $starttime;
        # Seconds in a 30 day month
        # 2592000
        my $months = int($timediff / 2592000) + 1;
        my $average = $views / $months;
        print int($average);
        die;
}

unless ($query->param("noview") == 1) {
# Increase views unless noview was set
        $views++;
        $node->setAttribute('views', $views);

        commit_changes($data, $data_file, $lasterror)
                || error($lasterror);
}

print $views;

##########################
#      COMMON SUBS       #
##########################

sub error ($) {
        my ($errormsg) = @_;
        print "<h2>Error</h2>\n";
        print "<p>Please note the information below, this was the cause of the
error.</p>\n";
        print "<p>" . $errormsg . "</p>\n";
        open ( ERRORS, ">>$error_file" );
        print ERRORS $errormsg . "\n";
        close ( ERRORS );
        die;
}

##########################
#       DOM STUFF        #
##########################

sub build_dom (\$\$\$) {
        my ($doc, $config, $errormsg) = @_;

        my $parser = XML::LibXML->new();
        $parser->validation(0);
        $parser->expand_entities(1);
        $parser->keep_blanks(0);
        $parser->pedantic_parser(0);
        $parser->load_ext_dtd(0);
        $parser->complete_attributes(1);

        eval { $$doc = $parser->parse_file( $$config ) };
        if ($@) { $$errormsg = "build_dom error: " . $@ . "\n"; return 0; }
        else { return 1; }
}

sub commit_changes ($$\$) {
        my ($doc, $file, $errormsg) = @_;
        my $fh;
        unless ($fh = IO::AtomicFile->open($file,"w"))  { $$errormsg = "Couldn't
open filehandle to $file : $!";
                                                          return 0; }

        eval    { $doc->toFH($fh, 1) };
        if ($@) { $fh->delete();
                  $$errormsg = "commit_changes error with $file : " . $@ . "\n";
                  return 0;
        } elsif ( not $fh->close() )    { $$errormsg = "Couldn't write file $file";
        } else { return 1 }
}

-=-=-=-=-=Script Ends=-=-=-=-=-


-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>