Skip to content
This repository
Browse code

Perl API for updating nodes.cf files

  • Loading branch information...
commit 0f99c80d633146a3c22fee9eea8fe9aa80996c44 1 parent 9641299
authored
9  perl_seco_data_writer/index.yaml
... ...
@@ -0,0 +1,9 @@
  1
+---
  2
+default:
  3
+  name: perl-seco-data-writer
  4
+  summary: a write interface to seco range data 
  5
+  arch: noarch
  6
+  version: '0.0.2'
  7
+  requires:
  8
+    - perl-seco-p4
  9
+
4  perl_seco_data_writer/source/Makefile.PL
... ...
@@ -0,0 +1,4 @@
  1
+use ExtUtils::MakeMaker;
  2
+WriteMakefile ( NAME => 'Seco::Data::Writer',
  3
+                VERSION => '0.01',
  4
+              );
320  perl_seco_data_writer/source/lib/Seco/Data/Writer.pm
... ...
@@ -0,0 +1,320 @@
  1
+package Seco::Data::Writer;
  2
+
  3
+use strict;
  4
+use warnings;
  5
+
  6
+use Carp;
  7
+use Scalar::Util qw/weaken/;
  8
+use File::Copy;
  9
+use File::Spec;
  10
+use File::Temp;
  11
+use POSIX qw/strftime/;
  12
+
  13
+use Seco::Libcrange;
  14
+use Seco::Data::Writer::Key;
  15
+use Seco::Data::Writer::Text;
  16
+
  17
+use constant NO  => 0;
  18
+use constant YES => 1;
  19
+
  20
+
  21
+sub new {
  22
+    my ( $class, %args ) = @_;
  23
+    my $self = {
  24
+        cluster       => $args{cluster},
  25
+        dirty         => NO,
  26
+        edit          => NO,
  27
+        seco_alt_path => File::Spec->canonpath ($args{seco_alt_path}) . '/',
  28
+        changelog_path => File::Spec->canonpath ($args{changelog_path}) . '/',
  29
+        r             => undef,
  30
+        __init__      => NO,
  31
+        create        => $args{create} ? YES : NO,
  32
+    };
  33
+
  34
+    if (defined $args{r}) {
  35
+       $self->{r} = $args{r};
  36
+    }
  37
+    else {
  38
+        ### XXX: enhance Seco::Libcrange to expose methods
  39
+        ### for adding modules/setting vars
  40
+        my ( $tfh, $tmpfile ) = File::Temp::tempfile();
  41
+        croak "tmpfile failed: $!"
  42
+            unless ( defined $tfh && -f $tmpfile );
  43
+        print $tfh "nodescf_path=$self->{seco_alt_path}\n";
  44
+        print $tfh "loadmodule nodescf\n";
  45
+        close $tfh;
  46
+        $self->{r_config} = $tmpfile;
  47
+        $self->{r} = Seco::Libcrange::->new($tmpfile);
  48
+    }
  49
+    $self->{edit} = defined  $args{edit} ? YES : NO;
  50
+    bless( $self, $class );
  51
+    $self->__init__;
  52
+    return $self;
  53
+}
  54
+
  55
+sub cluster {
  56
+    return $_[0]->{cluster};
  57
+}
  58
+
  59
+sub __init__ {
  60
+    return unless ( $_[0]->{__init__} == 0 );
  61
+
  62
+    my $self = shift;
  63
+    my $weakself = $self;
  64
+    weaken($self);
  65
+
  66
+    no strict 'refs';
  67
+    $self->{backend} =
  68
+      Seco::Data::Writer::Text::->init(
  69
+        'seco_alt_path' => $self->{seco_alt_path},
  70
+        'cluster'       => $self->{cluster} ,
  71
+        'r'             => $self->{r},
  72
+        'create'        => $self->{create},
  73
+      );
  74
+
  75
+    foreach my $key ( $self->dumpKeys ) {
  76
+        $self->{$key} = Seco::Data::Writer::Key->new(
  77
+            "parent" => $weakself,
  78
+            "name"   => $key,
  79
+            "data"   => undef,
  80
+        );
  81
+    }
  82
+
  83
+    if ($self->{create}) {
  84
+        if (! $self->{ALL}) {
  85
+            $self->addKey('ALL');
  86
+        }
  87
+        if (! $self->{STABLE}) {
  88
+            $self->addKey('STABLE', '$ALL');
  89
+            $self->getKey('STABLE')->exclude('%ngd-inactive:ALL & $ALL', undef, 1);
  90
+        }
  91
+        if (! $self->{CLUSTER}) {
  92
+            $self->addKey('CLUSTER', '$STABLE');
  93
+        }
  94
+        
  95
+    }
  96
+    $self->{__init__} = YES;
  97
+}
  98
+
  99
+sub todo {
  100
+    my ( $self, $key, $action, @args ) = @_;
  101
+    no strict 'refs';
  102
+    $self->noteChange($key, $action, @args);
  103
+    $self->{backend}->$action( $key, @args );
  104
+}
  105
+
  106
+sub noteChange {
  107
+    my $self = shift;
  108
+    my $key = shift;
  109
+    my $action = shift;
  110
+    my @vals = @_;
  111
+
  112
+    if ($action =~ /^(dump|has_|get)/) {
  113
+        return;
  114
+    }
  115
+
  116
+    my @caller = caller(2);
  117
+    my $class = shift(@caller);
  118
+
  119
+    my @v;
  120
+    foreach my $v (@vals) {
  121
+        if (defined($v) && $v !~ /^$/) {
  122
+            push(@v, $v);
  123
+        }
  124
+    }
  125
+    @vals = @v;
  126
+    my $vals = shift(@vals);
  127
+    $vals ||= '';
  128
+    #$vals = join(',', grep(!/^$/, @vals));
  129
+    push(@{$self->{_changes}}, [ $class, $key, $action, $vals ]);
  130
+}
  131
+
  132
+sub displayChanges {
  133
+    my $self = shift;
  134
+    foreach my $change (@{$self->{_changes}}) {
  135
+        my ($caller, $key, $action, $vals) = @{$change};
  136
+        print "CHANGE: $caller | $key | $action | $vals\n";
  137
+    }
  138
+}
  139
+
  140
+sub writeChanges {
  141
+    my $self = shift;
  142
+    my $msg = shift;
  143
+
  144
+    return unless ( $self->{dirty} && $self->{edit} );
  145
+
  146
+    my $path = $self->{changelog_path} . $self->{cluster};
  147
+
  148
+    my $ts = strftime('%Y-%m-%d %H:%M:%S', gmtime());
  149
+
  150
+    my $changes = "---\n- [$ts, $msg]\n";
  151
+    foreach my $change (@{$self->{_changes}}) {
  152
+        my ($caller, $key, $action, $vals) = @{$change};
  153
+        $changes .= "- [$caller, $key, $action, \"$vals\"]\n";
  154
+    }
  155
+    if (! open(F, ">>$path")) {
  156
+        print STDERR "open: $path: $!";
  157
+        return 0;
  158
+    }
  159
+
  160
+    print F $changes;
  161
+    close(F);
  162
+
  163
+    return 1;
  164
+}
  165
+
  166
+sub dumpKeys {
  167
+    return $_[0]->{r}->expand( "%" . $_[0]->{cluster} . ":KEYS" );
  168
+}
  169
+
  170
+sub dumpRawKeys {
  171
+    $_[0]->todo( undef, 'dumpRawKeys' );
  172
+}
  173
+
  174
+sub getKeys {
  175
+    my ($self) = shift;
  176
+    return
  177
+      map { $self->{$_} } ( $self->{r}->expand( "%" . $self->{cluster} . ":KEYS" ) );
  178
+}
  179
+
  180
+sub getKey {
  181
+    my ( $self, $key ) = @_;
  182
+    croak "unknown key ($key)" unless ( $self->{$key} );
  183
+    return $self->{$key};
  184
+}
  185
+
  186
+sub hasKey {
  187
+    my ($self, $key) = @_;
  188
+
  189
+    return exists($self->{$key});
  190
+}
  191
+
  192
+sub addKey {
  193
+    my ( $self, $key, $range, $comment ) = @_;
  194
+    croak "key exists ($key)" if ( $self->{$key} );
  195
+
  196
+    my $weakself = $self;
  197
+    weaken($weakself);
  198
+    $self->{$key} = Seco::Data::Writer::Key->new(
  199
+        parent => $weakself,
  200
+        name   => $key,
  201
+    );
  202
+    $self->todo( $key, 'addKey', $range, $comment);
  203
+    $self->{dirty} = YES;
  204
+    return $self->{$key};
  205
+}
  206
+
  207
+sub deleteKey {
  208
+    my ( $self, $key ) = @_;
  209
+    croak "unknown key ($key)" unless ( $self->{$key} );
  210
+    $self->todo( $key, 'deleteKey' );
  211
+    delete $self->{$key} if ( $self->{$key} );
  212
+    $self->{dirty} = YES;
  213
+}
  214
+
  215
+sub getRawKey {
  216
+    my ( $self, $key ) = @_;
  217
+    croak "unknown key ($key)" unless ( $self->{$key} );
  218
+    return $self->todo( $key, 'getRawKey' );
  219
+}
  220
+
  221
+sub clone {
  222
+   my ( $self, $src, $range, $comment ) = @_;
  223
+   my $no_check = 1;
  224
+   foreach my $kobj ($self->getKeys) {
  225
+      $kobj->include($range, $comment, $no_check) 
  226
+        if ( $kobj->has_simple_include($src));
  227
+      $kobj->exclude($range, $comment, $no_check) 
  228
+        if ( $kobj->has_simple_exclude($src));
  229
+   }
  230
+}
  231
+
  232
+
  233
+sub write {
  234
+    return unless ( $_[0]->{dirty} && $_[0]->{edit} );
  235
+    my $self = shift;
  236
+    $self->{backend}->write;
  237
+}
  238
+
  239
+sub cleanup {
  240
+    return unless ( $_[0]->{dirty} && $_[0]->{edit} );
  241
+    my $self = shift;
  242
+    $self->{backend}->cleanup;
  243
+}
  244
+
  245
+sub diff {
  246
+    return unless ( $_[0]->{dirty} && $_[0]->{edit} );
  247
+    my $self = shift;
  248
+    $self->{backend}->diff;
  249
+}
  250
+
  251
+sub inheritKeys {
  252
+    my $self = shift;
  253
+    my $source = shift;
  254
+    my @keys = @_;
  255
+
  256
+    if (! scalar(@keys)) {
  257
+        @keys = grep(!/^_comment/, $source->dumpRawKeys);
  258
+    }
  259
+
  260
+    my $cluster = $source->{cluster};
  261
+
  262
+    foreach my $key (@keys) {
  263
+        if ($key =~ /^(ALL|STABLE|CLUSTER)$/) {
  264
+            next;
  265
+        }
  266
+        if ($self->hasKey($key)) {
  267
+            $self->deleteKey($key);
  268
+        }
  269
+        $self->addKey($key, '%' . $cluster . ':' . $key);
  270
+    }
  271
+}
  272
+
  273
+sub copyKeys {
  274
+    my $self = shift;
  275
+    my $source = shift;
  276
+    my @keys = @_;
  277
+
  278
+    if (! scalar(@keys)) {
  279
+        @keys = grep(!/^_comment/, $source->dumpRawKeys);
  280
+    }
  281
+
  282
+    foreach my $key (@keys) {
  283
+        if ($key =~ /^(ALL|STABLE|CLUSTER)$/) {
  284
+            next;
  285
+        }
  286
+        if ($self->hasKey($key)) {
  287
+            $self->deleteKey($key);
  288
+        }
  289
+        my @r = $source->getRawKey($key);
  290
+        if (!scalar(@r)) {
  291
+            $self->addKey($key, undef);
  292
+            next;
  293
+        }
  294
+        my $v = shift(@r);
  295
+        my ($tag, $range, $comment) = @{$v};
  296
+        croak "first entry in $key is not INCLUDE" if ($tag ne 'INCLUDE');
  297
+        my $k = $self->addKey($key, $range, $comment);
  298
+        foreach my $v (@r) {
  299
+            my ($tag, $range, $comment) = @{$v};
  300
+            if ($tag eq 'INCLUDE') {
  301
+                $k->include($range, $comment, 1);
  302
+            } elsif ($tag eq 'EXCLUDE') {
  303
+                $k->exclude($range, $comment, 1);
  304
+            } else {
  305
+                croak "don't know tag $tag";
  306
+            }
  307
+        }
  308
+    }
  309
+}
  310
+
  311
+sub DESTROY {
  312
+    my $self = shift;
  313
+    if ($self->{r_config} =~ /^\/tmp/) {
  314
+        unlink($self->{r_config});
  315
+    }
  316
+}
  317
+
  318
+1;
  319
+
  320
+# vim ts=4 expandtab syntax=perl
122  perl_seco_data_writer/source/lib/Seco/Data/Writer/Key.pm
... ...
@@ -0,0 +1,122 @@
  1
+# Module to handle each invidiual key
  2
+package Seco::Data::Writer::Key;
  3
+
  4
+use strict;
  5
+use warnings;
  6
+
  7
+use Carp;
  8
+
  9
+sub new {
  10
+    my ( $class, %args ) = @_;
  11
+    my $self = {};
  12
+    $self->{key}     = $args{'name'}   || croak "need a key";
  13
+    $self->{parent}  = $args{'parent'} || croak "need a reference to parent";
  14
+    return bless( $self, $class );
  15
+}
  16
+
  17
+
  18
+sub has_simple_exclude {
  19
+    my ( $self, $range ) = @_;
  20
+    $self->{parent}->todo( $self->{key}, "has_simple_exclude", $range );
  21
+}
  22
+
  23
+sub has_simple_include {
  24
+    my ( $self, $range ) = @_;
  25
+    $self->{parent}->todo( $self->{key}, "has_simple_include", $range );
  26
+}
  27
+
  28
+sub include {
  29
+    my ( $self, $range, $comment, $no_check ) = @_;
  30
+    my $r = $self->{parent}{r};
  31
+    my $to_include = $no_check ? $range
  32
+                               : $r->range_sub( $range, $self->getRange );
  33
+    if (! $to_include && ! $no_check) {
  34
+        print STDERR "WARNING: not including [$range] in [" . $self->{parent}->{cluster} . "] because it already exists there.\n";
  35
+        return;
  36
+    }
  37
+    $self->{parent}->todo( $self->{key}, "include", $to_include, $comment );
  38
+    $self->dirty;
  39
+    return $to_include;
  40
+}
  41
+
  42
+sub exclude {
  43
+    my ( $self, $range, $comment, $no_check ) = @_;
  44
+    my $r = $self->{parent}{r};
  45
+    my $to_exclude = $no_check ? $range 
  46
+                               : $r->range_and( $range, $self->getRange );;
  47
+    if (! $to_exclude && ! $no_check) {
  48
+        print STDERR "WARNING: not excluding [$range] from [" . $self->{parent}->{cluster} . "] because it doesn't exist there.\n";
  49
+        return;
  50
+    }
  51
+    $self->{parent}->todo( $self->{key}, "exclude", $to_exclude, $comment );
  52
+    $self->dirty;
  53
+    return $to_exclude;
  54
+}
  55
+
  56
+sub rmexclude {
  57
+    my ( $self, $range, $no_check ) = @_;
  58
+    my $r = $self->{parent}{r};
  59
+    my $to_rmexclude = $no_check ? $range 
  60
+                                 : $r->range_sub ($range, $self->getRange );
  61
+    if (! $to_rmexclude && ! $no_check) {
  62
+        print STDERR "WARNING: not removing exclude [$range] from [" . $self->{parent}->{cluster} . "].\n";
  63
+        return;
  64
+    }
  65
+    $self->{parent}->todo( $self->{key}, "rmexclude", $to_rmexclude );
  66
+    $self->dirty;
  67
+    return $to_rmexclude;
  68
+}
  69
+
  70
+sub rminclude {
  71
+    my ( $self, $range, $no_check ) = @_;
  72
+    my $r = $self->{parent}{r};
  73
+    my $to_rminclude = $no_check ? $range
  74
+                                 : $r->range_and ( $self->getRange,$range);
  75
+    if (! $to_rminclude && ! $no_check) {
  76
+        print STDERR "WARNING: not removing include [$range] from [" . $self->{parent}->{cluster} . "].\n";
  77
+        return;
  78
+    }
  79
+    $self->{parent}->todo( $self->{key}, "rminclude", $to_rminclude );
  80
+    $self->dirty;
  81
+    return $to_rminclude;
  82
+}
  83
+
  84
+
  85
+sub set {
  86
+    my ( $self, $range ) = @_;
  87
+    $self->{parent}->todo( $self->{key},"set",$range);
  88
+    $self->dirty;
  89
+	return $range;
  90
+}
  91
+
  92
+sub dirty {
  93
+    return ( $_[0]->{parent}->{dirty} = 1 );
  94
+}
  95
+
  96
+sub getRange {
  97
+    my $self = shift;
  98
+    my $r = $self->{parent}{r};
  99
+    return $r->get_range( "%" . $self->{parent}->cluster . ":" . $self->{key} );
  100
+}
  101
+
  102
+sub take {
  103
+    my $self = shift;
  104
+    my $source = shift;
  105
+    my @values = shift;
  106
+
  107
+    foreach my $val (@values) {
  108
+        if (! $source->has_simple_include($val)) {
  109
+            croak "value $val in key $source does not exist";
  110
+        }
  111
+    }
  112
+    foreach my $val (@values) {
  113
+        $source->rminclude($val);
  114
+        $self->include($val);
  115
+    }
  116
+}
  117
+
  118
+1;
  119
+
  120
+__END__
  121
+
  122
+#vim expandtab ts=4 syntax=perl
276  perl_seco_data_writer/source/lib/Seco/Data/Writer/Meta.pm
... ...
@@ -0,0 +1,276 @@
  1
+use strict;
  2
+
  3
+package Seco::Data::Writer::Meta;
  4
+
  5
+use base qw/Seco::Bootie/;
  6
+
  7
+use Seco::Data::Writer;
  8
+use POSIX qw/strftime/;
  9
+use YAML::Syck qw/Dump/;
  10
+
  11
+sub options {
  12
+    $_[0]->SUPER::options,
  13
+    seco_alt_path   => [ undef, "path to seco conf" ],
  14
+    changelog       => [ '', "path to changelog base" ],
  15
+}
  16
+
  17
+sub new_cluster {
  18
+    my $self = shift;
  19
+    my $cluster = shift;
  20
+
  21
+    $cluster = $self->cluster($cluster, 1);
  22
+
  23
+    return $cluster;
  24
+}
  25
+
  26
+sub cluster {
  27
+    my $self = shift;
  28
+    my $cluster = shift;
  29
+    my $create = shift;
  30
+
  31
+    if (! exists($self->{_clusters}->{$cluster})) {
  32
+        $self->{_clusters}->{$cluster} = Seco::Data::Writer->new(
  33
+            seco_alt_path => $self->option('seco_alt_path'), 
  34
+            cluster => $cluster, 
  35
+            edit => 1, 
  36
+            create => $create,
  37
+            changelog_path => $self->option('changelog'),
  38
+        );
  39
+    }
  40
+    return $self->{_clusters}->{$cluster};
  41
+}
  42
+
  43
+sub init {
  44
+    my $self = shift;
  45
+
  46
+    if (! $self->SUPER::init()) {
  47
+        return;
  48
+    }
  49
+
  50
+    if ($self->option('changelog')) {
  51
+        my $changelog = $self->option('changelog');
  52
+        if (! -d $changelog) {
  53
+            return $self->error("changelog path $changelog does not exist");
  54
+        }
  55
+    }
  56
+    if (! -d $self->option('seco_alt_path') ) {
  57
+        return $self->error("path " . $self->option('seco_alt_path') . " does not exist");
  58
+    }
  59
+
  60
+    return 1;
  61
+}
  62
+
  63
+sub diff {
  64
+    my $self = shift;
  65
+    foreach my $cluster (sort keys(%{$self->{_clusters}})) {
  66
+        print "Index: $cluster\n";
  67
+        print "===================================================================\n";
  68
+        $self->{_clusters}->{$cluster}->diff();
  69
+        $self->{_clusters}->{$cluster}->cleanup();
  70
+    }
  71
+    $self->display_changes();
  72
+}
  73
+
  74
+sub display_changes {
  75
+    my $self = shift;
  76
+    foreach my $cluster (sort keys(%{$self->{_clusters}})) {
  77
+        print "cluster changes: $cluster\n";
  78
+        $self->{_clusters}->{$cluster}->displayChanges();
  79
+    }
  80
+    my @changes;
  81
+}
  82
+
  83
+sub username { $ENV{USER}; }
  84
+
  85
+
  86
+sub commit {
  87
+    my $self = shift;
  88
+    my $msg = shift;
  89
+
  90
+    if (! $self->commit_clusters()) {
  91
+        return $self->error("could not commit clusters");
  92
+    }
  93
+    return $self->commit_changelogs($msg);
  94
+}
  95
+
  96
+sub commit_clusters {
  97
+    my $self = shift;
  98
+    my $msg = shift;
  99
+
  100
+    my @changed;
  101
+
  102
+    foreach my $cluster (keys(%{$self->{_clusters}})) {
  103
+        if ($self->{_clusters}->{$cluster}->{dirty}) {
  104
+            if (! $self->commit_cluster($cluster)) {
  105
+                return $self->error("could not commit changes to $cluster");
  106
+            }
  107
+            push(@{$self->{_changed_clusters}}, $cluster);
  108
+        }
  109
+    }
  110
+
  111
+    return 1;
  112
+}
  113
+
  114
+sub commit_changelogs {
  115
+    my $self = shift;
  116
+    my $msg = shift;
  117
+    my $rev = shift;
  118
+
  119
+    $msg = $self->username . ($rev ? ", $rev" : "") . ", \"$msg\"";
  120
+
  121
+    my $changelog = $self->option('changelog');
  122
+    if (! $changelog) {
  123
+        return 1;
  124
+    }
  125
+
  126
+    if (! $self->{_changed_clusters}) {
  127
+        return 1;
  128
+    }
  129
+    my @clusters = @{$self->{_changed_clusters}};
  130
+    foreach my $cluster (@clusters) {
  131
+        if (! $self->commit_changelog($cluster, $msg)) {
  132
+            $self->error("changelog write for $cluster failed. continueing");
  133
+        }
  134
+    }
  135
+
  136
+    return 1;
  137
+}
  138
+
  139
+sub commit_changelog {  
  140
+    my $self = shift;
  141
+    my $cluster = shift;
  142
+    my $msg = shift;
  143
+
  144
+    my $path = $self->option('changelog') . "/$cluster";
  145
+    if (-f $path) {
  146
+        return $self->update_changelog($cluster, $msg);
  147
+    } else {
  148
+        return $self->create_changelog($cluster, $msg);
  149
+    }
  150
+}
  151
+
  152
+sub create_changelog {
  153
+    my $self = shift;
  154
+    my $cluster = shift;
  155
+    my $msg = shift;
  156
+
  157
+    my $path = $self->option('changelog') . "/$cluster";
  158
+    $self->verbose("creating $path");
  159
+    if (! $self->{_clusters}->{$cluster}->writeChanges($msg)) {
  160
+        return $self->error("writeChanges() failed");
  161
+    }
  162
+    return 1;
  163
+}
  164
+
  165
+sub update_changelog {
  166
+    my $self = shift;
  167
+    my $cluster = shift;
  168
+    my $msg = shift;
  169
+
  170
+    my $path = $self->option('changelog') . "/$cluster";
  171
+    $self->verbose("updating $path");
  172
+    if (! $self->{_clusters}->{$cluster}->writeChanges($msg)) {
  173
+        return $self->error("writeChanges() failed");
  174
+    }
  175
+    return 1;
  176
+}
  177
+
  178
+sub DESTROY {
  179
+    my $self = shift;
  180
+
  181
+    foreach my $cluster (sort keys(%{$self->{_clusters}})) {
  182
+        $self->{_clusters}->{$cluster}->cleanup();
  183
+    }
  184
+}
  185
+
  186
+sub addChangeRefs {
  187
+    my $self = shift;
  188
+    my $reference = shift;
  189
+
  190
+    my $date = strftime('%Y-%m-%d', gmtime);
  191
+    foreach my $cluster (sort keys(%{$self->{_clusters}})) {
  192
+        if ($self->{_clusters}->{$cluster}->{dirty}) {
  193
+            if (! $self->{_clusters}->{$cluster}->hasKey('CHANGES')) {
  194
+                $self->{_clusters}->{$cluster}->addKey('CHANGES');
  195
+            }
  196
+            $self->{_clusters}->{$cluster}->getKey('CHANGES')->include('q(' . $date . ';' . $reference . ')');
  197
+        }
  198
+    }
  199
+}
  200
+
  201
+sub createDependentCluster {
  202
+    my $self = shift;
  203
+    my $orig = shift;
  204
+    my $new = shift;
  205
+
  206
+    $self->new_cluster($new);
  207
+    $self->cluster($new)->inheritKeys($self->cluster($orig));
  208
+}
  209
+
  210
+
  211
+sub commit_cluster {
  212
+    my $self = shift;
  213
+    my $cluster = shift;
  214
+
  215
+    my $path = $self->{_clusters}->{$cluster}->{backend}->{file};
  216
+
  217
+    if (-e $path) {
  218
+        return $self->update_cluster($cluster);
  219
+    } 
  220
+
  221
+    return $self->create_cluster($cluster);
  222
+}
  223
+
  224
+sub create_cluster {
  225
+    my $self = shift;
  226
+    my $cluster = shift;
  227
+
  228
+    my $path = $self->{_clusters}->{$cluster}->{backend}->{file};
  229
+    my @mk = $self->mkparentdirs($path);
  230
+    if (! @mk) {
  231
+        return $self->error("Could not create $path");
  232
+    }
  233
+    if (! $self->{_clusters}->{$cluster}->write()) {
  234
+        return $self->error("could not write $path");
  235
+    }
  236
+    if (! chmod(0644, $path)) {
  237
+        return $self->error("could not chmod $path");
  238
+    }
  239
+    $self->{_mkparentdir_top} = shift(@mk);
  240
+    return 1;
  241
+}
  242
+
  243
+sub update_cluster {
  244
+    my $self = shift;
  245
+    my $cluster = shift;
  246
+
  247
+    my $path = $self->{_clusters}->{$cluster}->{backend}->{file};
  248
+    $self->verbose("updating $cluster ($path)");
  249
+    $self->{_clusters}->{$cluster}->write();
  250
+}
  251
+
  252
+sub mkparentdirs {
  253
+    my $self = shift;
  254
+    my $path = shift;
  255
+
  256
+    my @mk;
  257
+
  258
+    $self->verbose("mkparentdirs $path\n");
  259
+    my $p = '/';
  260
+    $path =~ s/[^\/]*$//;
  261
+    my @components = split(/\//, $path);
  262
+    foreach my $c (@components) {
  263
+        if (! $c) { next; }
  264
+        $p .= $c;
  265
+        if (! -d $p) {
  266
+            mkdir($p);
  267
+            push(@mk, $p);
  268
+        }
  269
+        $p .= '/';
  270
+    }
  271
+
  272
+    return @mk;
  273
+}
  274
+
  275
+1;
  276
+
77  perl_seco_data_writer/source/lib/Seco/Data/Writer/Meta/P4.pm
... ...
@@ -0,0 +1,77 @@
  1
+use strict;
  2
+
  3
+package Seco::Data::Writer::Meta::P4;
  4
+
  5
+use base qw/Seco::Data::Writer::Meta/;
  6
+
  7
+use Seco::P4::Client::Temporary;
  8
+use YAML::Syck qw/Dump/;
  9
+
  10
+sub options {
  11
+    $_[0]->SUPER::options,
  12
+    seco_depot => [ undef, "depot path to seco/tools/conf" ],
  13
+    seco_alt_path => [ '/', "unused" ],
  14
+}
  15
+
  16
+sub init {
  17
+    my $self = shift;
  18
+
  19
+    if (! $self->SUPER::init()) {
  20
+        return;
  21
+    }
  22
+
  23
+    $self->{_p4} = Seco::P4::Client::Temporary->new(
  24
+        views => { $self->option('seco_depot') => '/' },
  25
+        verbose => $self->{_verbose},
  26
+    );
  27
+
  28
+    $self->setOption('seco_alt_path', $self->{_p4}->root());
  29
+}
  30
+
  31
+sub commit {
  32
+    my $self = shift;
  33
+
  34
+    foreach my $cluster (keys(%{$self->{_clusters}})) {
  35
+        if ($self->{_clusters}->{$cluster}->{dirty}) {
  36
+            my $path = $self->{_clusters}->{$cluster}->{backend}->{file};
  37
+            $self->verbose("updating $path");
  38
+            if (-e $path) {
  39
+                if (! $self->{_p4}->edit($path) ) {
  40
+                    return $self->error("could not p4 edit $path");
  41
+                }
  42
+                $self->{_clusters}->{$cluster}->write();
  43
+            } else {
  44
+                $self->mkparentdirs($path);
  45
+                $self->{_clusters}->{$cluster}->write();
  46
+                if (! $self->{_p4}->add($path) ) {
  47
+                    return $self->error("could not p4 add $path");
  48
+                }
  49
+            }
  50
+        }
  51
+    }
  52
+
  53
+    my $diff = $self->{_p4}->diff();
  54
+    print "$diff\n";
  55
+
  56
+    return 1;
  57
+}
  58
+
  59
+sub mkparentdirs {
  60
+    my $self = shift;
  61
+    my $path = shift;
  62
+
  63
+    $self->verbose("mkparentdirs $path\n");
  64
+    my $p = '/';
  65
+    $path =~ s/[^\/]*$//;
  66
+    my @components = split(/\//, $path);
  67
+    foreach my $c (@components) {
  68
+        if (! $c) { next; }
  69
+        $p .= $c;
  70
+        if (! -d $p) {
  71
+            mkdir($p);
  72
+        }
  73
+        $p .= '/';
  74
+    }
  75
+}
  76
+
  77
+1;
135  perl_seco_data_writer/source/lib/Seco/Data/Writer/Meta/SVN.pm
... ...
@@ -0,0 +1,135 @@
  1
+use strict;
  2
+
  3
+package Seco::Data::Writer::Meta::SVN;
  4
+
  5
+use base qw/Seco::Data::Writer::Meta/;
  6
+
  7
+use Seco::SVN::WorkingCopy::Temporary;
  8
+use YAML::Syck qw/Dump/;
  9
+
  10
+sub options {
  11
+    $_[0]->SUPER::options,
  12
+    path => [ 'path to svn repository' ],
  13
+    seco_alt_path => [ '/', "unused" ],
  14
+}
  15
+
  16
+sub init {
  17
+    my $self = shift;
  18
+
  19
+    $self->setOption('seco_alt_path', '/');
  20
+
  21
+    $self->{_svn} = new Seco::SVN::WorkingCopy::Temporary (
  22
+        svnroot => $self->option('path'),
  23
+        verbose => $self->{_verbose},
  24
+    );
  25
+    $self->setOption('seco_alt_path', $self->{_svn}->root());
  26
+    $self->{_rawopts}->{seco_alt_path} = $self->{_svn}->root();
  27
+
  28
+    if ($self->option('changelog') =~ /^svn/) {
  29
+        $self->{_svn_changelog} = new Seco::SVN::WorkingCopy::Temporary (
  30
+            svnroot => $self->option('changelog'),
  31
+            verbose => $self->{_verbose},
  32
+        );
  33
+        $self->{_rawopts}->{changelog} = $self->{_svn_changelog}->root();
  34
+        $self->setOption('changelog', $self->{_svn_changelog}->root())
  35
+    }
  36
+
  37
+    return 1;
  38
+}
  39
+
  40
+sub commit {
  41
+    my $self = shift;
  42
+    my $msg = shift;
  43
+
  44
+    if (! $self->commit_clusters()) {
  45
+        return $self->error("could not commit clusters");
  46
+    }
  47
+
  48
+    if (! $self->{_svn}->commit($msg)) {    
  49
+        return $self->error("svn commit failed");
  50
+    }
  51
+
  52
+    my $rev = $self->{_svn}->output('commitRev');
  53
+
  54
+    return $self->commit_changelogs($msg, $rev);
  55
+}
  56
+
  57
+sub commit_changelogs {
  58
+    my $self = shift;
  59
+    my $msg = shift;
  60
+    my $rev = shift;
  61
+
  62
+    if (! $self->SUPER::commit_changelogs($msg, $rev)) {
  63
+        return 0;
  64
+    }
  65
+
  66
+    if ($self->{_svn_changelog}) {
  67
+        if (! $self->{_svn_changelog}->commit($msg)) {    
  68
+            return $self->error("svn changelog commit failed");
  69
+        }
  70
+    }
  71
+    
  72
+    return 1;
  73
+}
  74
+
  75
+sub create_changelog {
  76
+    my $self = shift;
  77
+    my $cluster = shift;
  78
+    my $msg = shift;
  79
+
  80
+    if (! $self->SUPER::create_changelog($cluster, $msg)) {
  81
+        return 0;
  82
+    }
  83
+
  84
+    my $path = $self->option('changelog') . '/' . $cluster;
  85
+    
  86
+    if ($self->{_svn_changelog} && ! $self->{_svn_changelog}->add($path)) {
  87
+        return $self->error("could not svn add $path");
  88
+    }
  89
+
  90
+    return 1;
  91
+}
  92
+
  93
+sub update_changelog {
  94
+    my $self = shift;
  95
+    my $cluster = shift;
  96
+    my $msg = shift;
  97
+
  98
+    my $path = $self->option('changelog') . '/' . $cluster;
  99
+    
  100
+    if ($self->{_svn_changelog} && ! $self->{_svn_changelog}->edit($path)) {
  101
+        return $self->error("could not svn edit $path");
  102
+    }
  103
+
  104
+    return $self->SUPER::update_changelog($cluster, $msg);
  105
+}
  106
+
  107
+sub create_cluster {
  108
+    my $self = shift;
  109
+    my $cluster = shift;
  110
+
  111
+    if (! $self->SUPER::create_cluster($cluster)) {
  112
+        return 0;
  113
+    }
  114
+
  115
+    my $p = $self->{_mkparentdir_top};
  116
+
  117
+    if (! $self->{_svn}->add($p) ) {
  118
+        return $self->error("could not svn add $p");
  119
+    }
  120
+
  121
+    return 1;
  122
+}
  123
+
  124
+sub update_cluster {
  125
+    my $self = shift;
  126
+    my $cluster = shift;
  127
+
  128
+    my $path = $self->{_clusters}->{$cluster}->{backend}->{file};
  129
+    if (! $self->{_svn}->edit($path) ) {
  130
+        return $self->error("could not svn edit $path");
  131
+    }
  132
+    return $self->SUPER::update_cluster($cluster);
  133
+}
  134
+
  135
+1;
312  perl_seco_data_writer/source/lib/Seco/Data/Writer/Text.pm
... ...
@@ -0,0 +1,312 @@
  1
+package Seco::Data::Writer::Text;
  2
+
  3
+use strict;
  4
+use warnings FATAL => qw/uninitialized/;
  5
+
  6
+use Carp;
  7
+use File::Copy qw/move/;
  8
+use File::Temp;
  9
+use POSIX qw/strftime/;
  10
+
  11
+sub init {
  12
+    my ( $class, %args ) = @_;
  13
+    my $self = {};
  14
+
  15
+    
  16
+    $self->{cluster} = $args{'cluster'} || croak 'need cluster name';
  17
+    $self->{r}       = $args{'r'}       || croak 'need range obj';
  18
+    $self->{create}  = $args{'create'} ? 1 : 0;
  19
+
  20
+
  21
+    $self->{seco_alt_path} =
  22
+        $args{'seco_alt_path'}
  23
+      ? $args{'seco_alt_path'}
  24
+      : "/home/seco/tools/conf/";
  25
+    $self->{file} = $self->{seco_alt_path} . $self->{cluster} . "/nodes.cf";
  26
+    #range_set_altpath( $self->{seco_path} ); ## SDR no support :|
  27
+    bless( $self, $class );
  28
+    $self->__read__;
  29
+    return $self;
  30
+}
  31
+
  32
+
  33
+sub has_simple_exclude {
  34
+    my ($self,$key,$range) = @_;
  35
+    my $r = $self->{r};
  36
+    foreach my $l ( @{ $self->{data}{$key} } ) {
  37
+        my ( $tag, $val, $comment ) = parse_line($l);
  38
+        next unless ( defined $tag && $tag =~ /EXCLUDE/ );
  39
+        return 1 if ($r->is_simple_range($val) && $r->range_and( $val,$range));
  40
+    }
  41
+    return;
  42
+}
  43
+
  44
+sub has_simple_include {
  45
+    my ($self,$key,$range) = @_;
  46
+    my $r = $self->{r};
  47
+    foreach my $l ( @{ $self->{data}{$key} } ) {
  48
+        my ( $tag, $val, $comment ) = parse_line($l);
  49
+        next unless ( defined $tag && $tag =~ /INCLUDE/ );
  50
+        return 1 if ($r->is_simple_range($val) && $r->range_and( $val,$range));
  51
+    }
  52
+    return;
  53
+}
  54
+
  55
+sub getRawKey {
  56
+    my ($self,$key) = @_;
  57
+
  58
+    my @lines;
  59
+    foreach my $l ( @{ $self->{data}{$key} } ) {
  60
+        my ( $tag, $val, $comment ) = parse_line($l);
  61
+        next unless ( defined $tag );
  62
+        push(@lines, [ $tag, $val, $comment ]);
  63
+    }
  64
+
  65
+    return @lines;
  66
+}
  67
+
  68
+sub dumpRawKeys {
  69
+    my $self = shift;
  70
+
  71
+    return @{$self->{__KEYS_IN_ORDER__}}
  72
+}
  73
+
  74
+sub addKey {
  75
+    my ( $self, $key, $range, $comment) = @_;
  76
+    push( @{ $self->{__KEYS_IN_ORDER__} }, $key );
  77
+    if (defined $range) {
  78
+          $self->{data}{$key} 
  79
+           = [ defined $comment ? "INCLUDE $range #$comment"
  80
+                                : "INCLUDE $range" ];
  81
+    }
  82
+    else {
  83
+        $self->{data}{$key} = [];
  84
+    }
  85
+}
  86
+
  87
+sub deleteKey {
  88
+    my ( $self, $key ) = @_;
  89
+    delete $self->{data}{$key};
  90
+    my @tmp;
  91
+    foreach my $k ( @{ $self->{__KEYS_IN_ORDER__} } ) {
  92
+        unless ( $k eq $key ) { push( @tmp, $k ); }
  93
+    }
  94
+    $self->{__KEYS_IN_ORDER__} = \@tmp;
  95
+}
  96
+
  97
+sub set {
  98
+    my ($self,$key,$range,$comment) = @_;
  99
+    $self->{data}{$key} = undef unless (defined $range);
  100
+    $self->{data}{$key} = [ defined $comment ? "INCLUDE $range #$comment"
  101
+                                            : "INCLUDE $range" ];
  102
+}
  103
+
  104
+sub include {
  105
+    my ( $self, $key, $to_include, $comment ) = @_;
  106
+    push @{ $self->{data}{$key} }, 
  107
+            defined $comment ? "INCLUDE $to_include #$comment"
  108
+                             : "INCLUDE $to_include";
  109
+}
  110
+
  111
+sub exclude {
  112
+    my ( $self, $key, $to_exclude, $comment ) = @_;
  113
+    $to_exclude = "EXCLUDE $to_exclude";