Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Node Tracker

by smgfc (Monk)
on Mar 31, 2002 at 05:11 UTC ( [id://155560]=sourcecode: print w/replies, xml ) Need Help??
Category: PerlMonks Related Scripts
Author/Contact Info William Meyer, smgfc@mindspring.com
Description:

A simple little program that will keep a log of any changes to the title, id, or rep of your nodes, including the addition or deletion of said nodes.

2002-03-31 Edit by the node bunny : Changed login and password.

#!/usr/bin/perl -w
use strict;
use LWP::Simple;

my ($file, $user, $password, $root, $nodeurl, $url, $delimiter, $xp_xm
+l, %rep_hash);

$user = 'perlmonks witness protection';    #your username goes here
$password = 'changed to protect the guilty';    #your password goes he
+re

$root = 'http://www.perlmonks.org';
$nodeurl = '32704';

$delimiter = chr(1);

$file = 'Hard Disk:Desktop Folder:' . $user . '.pmxp';

$url = $root. '/index.pl?' . 'op=login&user=' . $user . '&passwd=' . $
+password . '&node=' . $nodeurl;    #create the url
$xp_xml = get($url) || die "Can't get $url: $!\n";    #grab the site/x
+ml
die "Authentifcation failed!" unless length($xp_xml) > 4; #stolen from
+ xml_pimp;

make_hash(\$xp_xml, \%rep_hash);

if (-e $file) {    #if the file exists

    diff_create(\%rep_hash, \$file, \$delimiter);
} else {    #if the file doesn't exist

    create_file(\%rep_hash, \$file, \$delimiter);
}

sub make_hash {    #grab the node info

    my ($xp_xml, $rep_hash) = @_;
    my ($rep, $time, $id, $title);

    while ($$xp_xml =~ m/<NODE reputation="(\d+?)" createtime="(.+?)" 
+id="(\d+?)">(.+?)<\/NODE>/g) {    #grab every node instance

        ($rep, $time, $id, $title) = ($1, $2, $3, $4);
        $time =~ s/ |:|-//g;    #remove the ' ', ':', and '-' from the
+ time for sorting
        $$rep_hash{$time} = [$title, $id, $rep];
    }
}

sub create_file {    #create the file

    my ($rep_hash, $file, $delimiter) = @_;
    my (@dates, $time);

    @dates = sort {$a <=> $b} keys %$rep_hash;    #sort the nodes by d
+ate

    open (FILE, ">$$file") || die "Can't open file $$file: $!\n";

    foreach (@dates) {
        ($time = $_) =~ s/^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$
+/$1-$2-$3 $4:$5:$6/;    #expand the time
        print FILE $$rep_hash{$_}[0] . $$delimiter . $$rep_hash{$_}[1]
+ . $$delimiter . $$rep_hash{$_}[2] . $$delimiter . $time . "\n";
    }
    print FILE $$delimiter x 8 . "\n";    #delimiter between raw info 
+and the actual log
    close (FILE);
}


sub diff_create {
    my ($rep_hash, $file, $delimiter) = @_;
    my ($check, $title, $id, $rep, $time, %old_rep_hash, @dates, @chan
+ges, @prev_changes);

    open (FILE, "+<$$file") || die "Can't open file $$file: $!\n";

    $check = 0;
    while (<FILE>) {
        chomp;
        $check = 1 if /^$$delimiter{8}$/;    #once you reach the delim
+iter between raw info and the actual log push the lines into an array
        if ($check == 0) {    
            ($title, $id, $rep, $time) = split /$$delimiter/, $_;
            $time =~ s/ |:|-//g;
            $old_rep_hash{$time} = [$title, $id, $rep];
        } else {
            push @prev_changes, $_;
        }
    }

    foreach (keys %$rep_hash) {    #check for changes
        if (exists $old_rep_hash{$_}) {
            if ($$rep_hash{$_}[0] ne $old_rep_hash{$_}[0]) {    #check
+ for title changes
                push @changes, 'Title of ' . $old_rep_hash{$_}[0] . ' 
+changed to ' . $$rep_hash{$_}[0];
            }
            if ($$rep_hash{$_}[1] != $old_rep_hash{$_}[1]) {    #check
+ for id changes
                push @changes, 'Id of ' . $$rep_hash{$_}[0] . ', ' . $
+old_rep_hash{$_}[1] . ', changed to ' . $$rep_hash{$_}[1];
            }
            if ($$rep_hash{$_}[2] != $old_rep_hash{$_}[2]) {    #check
+ for rep changes
                push @changes, 'Rep of ' . $$rep_hash{$_}[0] . ', ' . 
+$old_rep_hash{$_}[2] . ', changed to ' . $$rep_hash{$_}[2];
            }
        } else {    #if node added
            ($time = $_) =~ s/^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{
+2})$/$1-$2-$3 $4:$5:$6/;    #expand the time
            push @changes, $$rep_hash{$_}[0] . ' added at ' . $time . 
+' at id ' . $$rep_hash{$_}[1] . ' with a rep of ' . $$rep_hash{$_}[2]
+;
        }
    }

    foreach (keys %old_rep_hash) {    #check for deleted nodes
        unless (exists $$rep_hash{$_}) {
            ($time = $_) =~ s/^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{
+2})$/$1-$2-$3 $4:$5:$6/;     #expand the time
            push @changes, $old_rep_hash{$_}[0] . ' at id ' . $old_rep
+_hash{$_}[1] . ' with a rep of ' . $old_rep_hash{$_}[2] . " deleted";
        }
    }

    @dates = sort {$a <=> $b} keys %$rep_hash;    #sort the nodes by d
+ate

#####
# print to the file
#####

    seek(FILE, 0, 0);

    foreach (@dates) {
        ($time = $_) =~ s/^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$
+/$1-$2-$3 $4:$5:$6/;    #expand the time
        print FILE $$rep_hash{$_}[0] . $$delimiter . $$rep_hash{$_}[1]
+ . $$delimiter . $$rep_hash{$_}[2] . $$delimiter . $time . "\n";
    }
    
    foreach (@prev_changes) {
        print FILE $_ . "\n";
    }

    print FILE "\n\n******** Changes On " . gmtime() . " ********\n\n"
+;

    foreach (@changes) {
        print FILE $_ . "\n";
    }

    close (FILE);
}

UPDATE: There was a tiny bug when checking to see if the rep of node changed. It checked wether the title, changed not the rep (simple array index thing). It is now fixed.
UPDATE2: Fixed another bug checking wether a node id or rep had changed (ne instead of !=, a copy and paste error).
UPDATE3: Fixed some formatting stuff (added title to changes of rep and id).
UPDATE4: Thanks to jeffa got the bang added and in the right place in the shebang line, which made warnings yell at me about prototypes, so i removed the prototypes.Thanks again jeffa!

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://155560]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others learning in the Monastery: (4)
As of 2024-04-16 22:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found