diff options
| -rw-r--r-- | changed_update.pl | 119 |
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; + |