]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/commitdiff
projects / perl / modules / LaTeX-TikZ.git / commitdiff
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side (parent: 5d8e597)
Make LaTeX::TikZ::Scope objects immutable
authorVincent Pit <vince@profvince.com>
Thu, 14 Apr 2011 14:41:25 +0000 (16:41 +0200)
committerVincent Pit <vince@profvince.com>
Thu, 14 Apr 2011 14:41:25 +0000 (16:41 +0200)
lib/LaTeX/TikZ/Scope.pm patch | blob | history
lib/LaTeX/TikZ/Set.pm patch | blob | history
t/92-pod-coverage.t patch | blob | history

diff --git a/lib/LaTeX/TikZ/Scope.pm b/lib/LaTeX/TikZ/Scope.pm
index d8ce86183abfde264ab100125983fc7873a3b34e..1a57c613f36fbf1513be0a3f72d5ea3d331939d7 100644 (file)
--- a/lib/LaTeX/TikZ/Scope.pm
+++ b/lib/LaTeX/TikZ/Scope.pm
@@ -28,9 +28,9 @@ use Any::Moose;
 =cut
 
 has '_mods' => (
- is       => 'ro',
+ is       => 'rw',
  isa      => 'Maybe[ArrayRef[LaTeX::TikZ::Mod::Formatted]]',
- init_arg => undef,
+ init_arg => 'mods',
  default  => sub { [ ] },
 );
 
@@ -47,58 +47,47 @@ has '_mods_cache' => (
 
 =cut
 
-has '_body' => (
- is       => 'rw',
+has 'body' => (
+ is       => 'ro',
  isa      => 'LaTeX::TikZ::Scope|ArrayRef[Str]',
+ required => 1,
  init_arg => 'body',
 );
 
-my $my_tc    = LaTeX::TikZ::Tools::type_constraint(__PACKAGE__);
-my $ltmf_tc  = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Formatted');
-my $_body_tc = __PACKAGE__->meta->find_attribute_by_name('_body')
-                                ->type_constraint;
+my $my_tc   = LaTeX::TikZ::Tools::type_constraint(__PACKAGE__);
+my $ltmf_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Formatted');
+my $body_tc = __PACKAGE__->meta->find_attribute_by_name('body')
+                               ->type_constraint;
 
-=head1 METHODS
+around 'BUILDARGS' => sub {
+ my ($orig, $class, %args) = @_;
 
-=head2 C<mod>
+ my $mods = $args{mods};
+ if (defined $mods and ref $mods eq 'ARRAY') {
+  for my $mod (@$mods) {
+   $mod = $ltmf_tc->coerce($mod);
+  }
+ }
 
-=cut
+ $class->$orig(%args);
+};
 
-sub mod {
+sub BUILD {
  my $scope = shift;
 
  my $cache = $scope->_mods_cache;
 
- for (@_) {
-  my $mod = $ltmf_tc->coerce($_);
-  $ltmf_tc->assert_valid($mod);
+ my @unique_mods;
+ for my $mod ($scope->mods) {
   my $tag = $mod->tag;
   next if exists $cache->{$tag};
   $cache->{$tag} = $mod;
-  push @{$scope->_mods}, $mod;
- }
-
- $scope;
-}
-
-=head2 C<body>
-
-=cut
-
-sub body {
- my $scope = shift;
-
- if (@_) {
-  $scope->_body($_[0]);
-  $scope;
- } else {
-  @{$scope->_body};
+  push @unique_mods, $mod;
  }
+ $scope->_mods(\@unique_mods);
 }
 
-use overload (
- '@{}' => 'dereference',
-);
+=head1 METHODS
 
 =head2 C<flatten>
 
@@ -108,11 +97,12 @@ sub flatten {
  my ($scope) = @_;
 
  do {
-  my $body = $scope->_body;
+  my $body = $scope->body;
   return $scope unless $my_tc->check($body);
-  $scope = $scope->new
-                 ->mod ($scope->mods, $body->mods)
-                 ->body($body->_body)
+  $scope = $scope->new(
+   mods => [ $scope->mods, $body->mods ],
+   body => $body->body,
+  );
  } while (1);
 }
 
@@ -160,7 +150,7 @@ sub instantiate {
   }
  }
 
- my @body = $scope->body;
+ my @body = @{$scope->body};
 
  my $mods_string = @raw_mods ? ' [' . join(',', @raw_mods) . ']' : undef;
 
@@ -192,12 +182,6 @@ sub instantiate {
  return @body;
 }
 
-=head2 C<dereference>
-
-=cut
-
-sub dereference { [ $_[0]->instantiate ] }
-
 =head2 C<fold>
 
 =cut
@@ -227,20 +211,23 @@ sub fold {
    }
 
    if (!$has_different_layers and @$common) {
-    my $x = $left->new
-                 ->mod(@$only_left)
-                 ->body($left->_body);
-    my $y = $left->new
-                 ->mod(@$only_right)
-                 ->body($right->_body);
-    return $left->new
-                ->mod(@$common)
-                ->body(fold($x, $y, $rev));
+    my $x = $left->new(
+     mods => $only_left,
+     body => $left->body,
+    );
+    my $y = $left->new(
+     mods => $only_right,
+     body => $right->body,
+    );
+    return $left->new(
+     mods => $common,
+     body => fold($x, $y, $rev),
+    );
    } else {
     @right = $right->instantiate;
    }
   } else {
-   $_body_tc->assert_valid($right);
+   $body_tc->assert_valid($right);
    @right = @$right;
   }
 
@@ -249,7 +236,7 @@ sub fold {
   if ($my_tc->check($right)) {
    return fold($right, $left, 1);
   } else {
-   $_body_tc->assert_valid($_) for $left, $right;
+   $body_tc->assert_valid($_) for $left, $right;
    @left  = @$left;
    @right = @$right;
   }
@@ -258,6 +245,10 @@ sub fold {
  $rev ? [ @right, @left ] : [ @left, @right ];
 }
 
+use overload (
+ '@{}' => sub { [ $_[0]->instantiate ] },
+);
+
 __PACKAGE__->meta->make_immutable;
 
 =head1 SEE ALSO
diff --git a/lib/LaTeX/TikZ/Set.pm b/lib/LaTeX/TikZ/Set.pm
index e673097ec2f20e7a9349e8cabff8cdef3cfb84c3..a6dd87f034b776dfbef347cb0bee2b518728f726 100644 (file)
--- a/lib/LaTeX/TikZ/Set.pm
+++ b/lib/LaTeX/TikZ/Set.pm
@@ -94,9 +94,10 @@ around 'draw' => sub {
 
  my @mods = $cxt->effective_mods;
  if (@mods) {
-  $body = LaTeX::TikZ::Scope->new
-                            ->mod(map $_->apply($tikz), @mods)
-                            ->body($body);
+  $body = LaTeX::TikZ::Scope->new(
+   mods => [ map $_->apply($tikz), @mods ],
+   body => $body,
+  );
  }
 
  $body;
diff --git a/t/92-pod-coverage.t b/t/92-pod-coverage.t
index 49689882e7982464be52a9240e6ceda5bccdb9ac..db2daab818e64e4383bcb570b88526ce10aea0af 100644 (file)
--- a/t/92-pod-coverage.t
+++ b/t/92-pod-coverage.t
@@ -23,7 +23,7 @@ my $moose_private = { also_private => [ qr/^BUILD$/, qr/^DEMOLISH$/ ] };
 pod_coverage_ok( 'LaTeX::TikZ::Interface' );
 
 pod_coverage_ok( 'LaTeX::TikZ' );
-pod_coverage_ok( 'LaTeX::TikZ::Context', $moose_private);
+pod_coverage_ok( 'LaTeX::TikZ::Context', $moose_private );
 pod_coverage_ok( 'LaTeX::TikZ::Formatter' );
 pod_coverage_ok( 'LaTeX::TikZ::Functor' );
 pod_coverage_ok( 'LaTeX::TikZ::Functor::Rule' );
@@ -33,7 +33,7 @@ pod_coverage_ok( 'LaTeX::TikZ::Mod::Clip' );
 pod_coverage_ok( 'LaTeX::TikZ::Mod::Color' );
 pod_coverage_ok( 'LaTeX::TikZ::Mod::Fill' );
 pod_coverage_ok( 'LaTeX::TikZ::Mod::Formatted' );
-pod_coverage_ok( 'LaTeX::TikZ::Mod::Layer', $moose_private);
+pod_coverage_ok( 'LaTeX::TikZ::Mod::Layer', $moose_private );
 pod_coverage_ok( 'LaTeX::TikZ::Mod::Pattern' );
 pod_coverage_ok( 'LaTeX::TikZ::Mod::Pattern::Dots' );
 pod_coverage_ok( 'LaTeX::TikZ::Mod::Pattern::Lines' );
@@ -42,7 +42,7 @@ pod_coverage_ok( 'LaTeX::TikZ::Mod::Scale' );
 pod_coverage_ok( 'LaTeX::TikZ::Mod::Width' );
 pod_coverage_ok( 'LaTeX::TikZ::Point' );
 pod_coverage_ok( 'LaTeX::TikZ::Point::Math::Complex' );
-pod_coverage_ok( 'LaTeX::TikZ::Scope' );
+pod_coverage_ok( 'LaTeX::TikZ::Scope', $moose_private );
 pod_coverage_ok( 'LaTeX::TikZ::Set' );
 pod_coverage_ok( 'LaTeX::TikZ::Set::Arc' );
 pod_coverage_ok( 'LaTeX::TikZ::Set::Arrow' );
Perl object model for generating PGF/TikZ code.