added script to auto-updated "changed" field of %IRSSI hash when called on a script

1 files changed, 119 insertions, 0 deletions

diff --git a/changed_update.pl b/changed_update.pl
new file mode 100644
index 0000000..2e6b733
--- /dev/null
+++ b/changed_update.pl
@@ -0,0 +1,119 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use feature qw/say/;
+use DateTime;
+
+my $infile = $ARGV[0] // 'feature-tests/template.pl.copy';
+
+my $transform = PPI::Transform::UpdateTimestamp->new
+  (
+   updated => DateTime->now,
+   quiet   => 1
+  );
+
+
+my $ret = $transform->file($infile);
+
+say "Return value: " . defined $ret && $ret ? 'success' : 'failure';
+
+
+package PPI::Transform::UpdateTimestamp;
+
+use strict;
+use warnings;
+
+use PPI;
+use PPI::Dumper;
+use DateTime;
+
+use base 'PPI::Transform';
+
+our	$VERSION = '3.14';
+
+use feature qw/say/;
+
+sub new {
+    my ($class, @args) = @_;
+	my $self = $class->SUPER::new(@args);
+
+	# Must provide an updated timestamp.
+	unless ( exists ($self->{updated}) ) {
+		#PPI::Exception->throw("Did not provide a valid updated timestamp.");
+        my $now = DateTime->now();
+        carp "No updated value provided, using $now";
+        $self->set_updated($now);
+	}
+
+    return $self;
+}
+
+sub updated {
+    $_[0]->{updated};
+}
+sub quiet {
+    $_[0]->{quiet}
+}
+
+sub set_updated {
+    my ($self, $val) = shift;
+    $self->{updatd} = $val;
+}
+
+sub document {
+    my ($self, $doc) = @_;
+    die "Transform requires PPI::Document" unless ref($doc) eq 'PPI::Document';
+
+    my $vars = $doc->find('PPI::Statement::Variable');
+    my $ret = 0;
+    foreach my $var (@$vars) {
+        foreach my $vc ($var->children) {
+            if ($vc->class eq 'PPI::Token::Symbol' and
+                $vc->canonical eq '%IRSSI') {
+                say "Found IRSSI Hash, processing it" unless $self->quiet;
+                $ret = $self->examine_struct($vc->statement);
+            }
+        }
+    }
+    return $ret;
+}
+
+sub examine_struct {
+    my ($self, $stmt) = @_;
+    my $ret = 0;
+
+    unless ($self->quiet) {
+        my $dumper = PPI::Dumper->new($stmt);
+        $dumper->print();
+        say "-" x 60;
+    }
+
+    foreach my $node ($stmt->schildren) {
+
+        if ($node->class eq 'PPI::Structure::List') {
+
+            foreach my $t ($node->tokens) {
+                next unless $t->significant;
+                if ($t->class eq 'PPI::Token::Word' and
+                    $t->content =~ m/updated/) {
+
+                    my $val = $t->snext_sibling->snext_sibling;
+                    $val->set_content($self->updated);
+
+                    if ($val->content eq $self->updated) {
+                        $ret = 1;
+                    }
+                    
+                    say "Thingie: " . $t->content unless $self->quiet;
+                    say "value set to: " . $val->content unless $self->quiet;
+                }
+            }
+        }
+    }
+    return $ret;
+}
+
+1;
+