aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--changed_update.pl119
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;
+