view release on metacpan or  search on metacpan

lib/Tickit/Style.pm  view on Meta::CPAN

Definitions will be merged with existing definitions in memory, with new
values overwriting existing values.

=cut

sub load_style
{
   shift;
   my ( $str ) = @_;
   _load_style( Tickit::Style::Parser->new->from_string( $str ) );
}

=head2 load_style_file

   Tickit::Style->load_style_file( $path )

Loads definitions from a stylesheet file given by the path.

Definitions will be merged the same way as C<load_style>.

=cut

sub load_style_file
{
   shift;
   my ( $path ) = @_;
   # TODO: use ->from_file( $path, binmode => ":encoding(UTF-8)" ) when available
   my $str = do {
      open my $fh, "<:encoding(UTF-8)", $path or croak "Cannot read $path - $!";
      local $/;
      <$fh>;
   };
   _load_style( Tickit::Style::Parser->new->from_string( $str ) );
}

=head2 load_style_from_DATA

   Tickit::Style->load_style_from_DATA

A convenient shortcut for loading style definitions from the caller's C<DATA>
filehandle.

=cut

sub load_style_from_DATA
{
   shift;
   my $pkg = caller;
   my $fh = do { no strict 'refs'; \*{"${pkg}::DATA"} };
   my $str = do { local $/; <$fh> };
   _load_style( Tickit::Style::Parser->new->from_string( $str ) );
}

=head2 on_style_load

   Tickit::Style::on_style_load( \&code )

Adds a CODE reference to be invoked after either C<load_style> or
C<load_style_file> are called. This may be useful to flush any caches or
invalidate any state that depends on style information.

=cut

sub on_style_load
{
   my ( $code ) = @_;
   push @ON_STYLE_LOAD, $code;
}

package # hide from indexer
   Tickit::Style::_Tagset;

use Struct::Dumb;

# A "Keyset" is the set of style keys applied to one particular set of style
# tags
struct Keyset => [qw( tags style )];

sub new
{
   my $class = shift;
   return bless [], $class;
}

sub clone
{
   my $proto = shift;
   return bless [ map { Keyset( $_->tags, { %{$_->style} } ) }
                      @$proto ], ref $proto;
}

sub add
{
   my $self = shift;
   my ( $key, $value ) = @_;

   my %tags;
   $tags{$1}++ while $key =~ s/:([A-Z0-9_-]+)//i;

   $self->merge_with_tags( \%tags, { $key => $value } );
}

sub merge
{
   my $self = shift;
   my ( $other ) = @_;

   foreach my $keyset ( $other->keysets ) {
      $self->merge_with_tags( $keyset->tags, $keyset->style );
   }
}

sub merge_with_tags
{
   my $self = shift;
   my ( $tags, $style ) = @_;

   my $keyset = Keyset( $tags, $style );
   @$self = ( $keyset ) and return if !@$self;