blob: 15f6667f92dbef4fcc4b1c171c8375978f964fed (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use DateTime;
my $infile = $ARGV[0] // die "No File provided"; #'feature-tests/template.pl.copy';
my $transform = PPI::Transform::UpdateTimestamp->new
(
updated => DateTime->now,
quiet => 1
);
my $ret = $transform->file($infile);
#say "Return value: " .
exit (defined $ret && $ret ? 0 : 1);
package PPI::Transform::UpdateTimestamp;
use strict;
use warnings;
use PPI;
use PPI::Dumper;
use DateTime;
use Carp qw/carp/;
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;
|
