docs/update_versions.pl at master · optionalg/docs · GitHub

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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
#!/usr/bin/env perl

use strict;
use warnings;
use v5.10;

use FindBin;
use lib "$FindBin::RealBin/lib";
use ES::Util qw($Opts);
use Getopt::Long;
use Path::Class qw(dir file);

GetOptions( $Opts, 'version=s', 'action=s', 'dir=s' );

my $dir = $Opts->{dir} or usage("No <dir> specified");
$dir = dir($dir);

my $action = $Opts->{action} or usage("No <action> specified");
if ( $action eq 'list' ) {
    list($dir);
    exit;
}

my $version = $Opts->{version} or usage("No <version> specified");

my $cb
    = $action eq 'release'   ? release($version)
    : $action eq 'unrelease' ? unrelease($version)
    : $action eq 'strip'     ? strip($version)
    :                          usage( "Unknown action: " . $action );

update( dir( $Opts->{dir} ), $cb );
list($dir);

#===================================
sub list {
#===================================
    my $dir = shift;
    my $re  = qr/\b(added|deprecated|coming)\[([^],]+)[^]]*\]/;
    my %versions;
    $dir->recurse(
        callback => sub {
            my $child = shift;
            return $child->PRUNE if $child->basename =~ /^\./;
            return if $child->is_dir;
            my $text = $child->slurp;
            while ( $text =~ /$re/g ) {
                $versions{$2}{$1}++;
            }
        }
    );
    print "Version          Added  Coming  Deprecated\n";
    print "------------------------------------------\n";

    for my $version ( sort keys %versions ) {
        printf "%-15s:   %3d     %3d      %3d\n",
            $version,
            map { $versions{$version}{$_} || 0 } qw(added coming deprecated);
    }
}
#===================================
sub release {
#===================================
    my $version = shift;
    sub {
        my $text = shift;
        $text =~ s/coming\[${version}([^\]]*)?\]/added[$version$1]/g;
        return $text;
        }
}

#===================================
sub unrelease {
#===================================
    my $version = shift;
    sub {
        my $text = shift;
        $text =~ s/added\[${version}([^\]]*)?\]/coming[$version$1]/g;
        return $text;
        }
}

#===================================
sub strip {
#===================================
    my $version = shift;
    my $note_re = qr/(?:added|deprecated|coming)\[${version}[^]]*\]\.?/;
    sub {
        my $text = shift;

        # block macro
        $text =~ s/^${note_re}([ ]*\n|\Z){1,2}//gm;
        $text =~ s/
            (?<=\S)[ ]+${note_re}  # with text before
          | ${note_re}[ ]*(?=\S)   # with text after
          | ^[ ]*${note_re}[ ]*$   # alone on line
        //gmx;
        return $text;
        }
}

#===================================
sub update {
#===================================
    my ( $dir, $cb ) = @_;
    $dir->recurse(
        callback => sub {
            my $child = shift;
            return $child->PRUNE if $child->basename =~ /^\./;
            return if $child->is_dir;
            my $old = $child->slurp;
            my $new = $cb->($old);
            return if $new eq $old;
            print "Updating: $child\n";
            $child->spew($new);
        }
    );
}

#===================================
sub init_env {
#===================================
    chdir($FindBin::RealBin) or die $!;

    $ENV{SGML_CATALOG_FILES} = $ENV{XML_CATALOG_FILES} = join ' ',
        file('resources/docbook-xsl-1.78.1/catalog.xml')->absolute,
        file('resources/docbook-xml-4.5/catalog.xml')->absolute;

    $ENV{PATH}
        = dir('resources/asciidoc-8.6.8/')->absolute . ':' . $ENV{PATH};

    eval { run( 'xsltproc', '--version' ) }
        or die "Please install <xsltproc>";
}

#===================================
sub usage {
#===================================
    my $error = shift;

    if ($error) {
        say "\nError: $error";
    }
    say <<USAGE;

        $0 --dir path/to/dir --action list
     OR
        $0 --dir path/to/dir --version 0.90.5 --action strip|release|unrelease

    Actions:
      strip:     removes added/deprecated/coming notes
      release:   changes coming notes to added notes
      unrelease: changes added notes to coming notes
USAGE

    exit !!$error;
}