view release on metacpan or  search on metacpan

lib/String/Smart.pm  view on Meta::CPAN

    add_rep reversed => sub { reverse $_[0] }, sub { reverse $_[0] };
    my $this = "Hello";
    my $that = reversed "Hello";
    print as reversed => $this, "\n";
    # prints "olleH"
    print as reversed => $that, "\n";
    # also prints "olleH"

A representation consists of a name and two subroutine references. The
first subroutine applies the encoding, the second reverses it. If either
subroutine is undefined a boilerplate subroutine that throws a
descriptive error will be used in its place.

=cut

sub add_rep($$$) {
  my ( $name, $to, $from ) = @_;

  croak "$name contains an underscore"
   if $name =~ /_/;

  my %spec = ( from => $from, to => $to );
  for my $dir ( keys %spec ) {
    unless ( defined $spec{$dir} ) {
      $spec{$dir} = sub {
        croak "Don't know how to convert $dir $name";
      };
    }
  }

  $rep_map{$name} = \%spec;
}

=head2 C<< as >>

Coerce a string into the specified encoding.

    my $representation = as html => $some_string;

Optionally multiple encodings my be supplied either like this:

    my $rep = as html_nl2br => $some_string;

Or like this:

    my $rep = as ['html', 'nl2br'], $some_string;

The returned object (actually a hash blessed to C<String::Smart>)
will have the specified encoding irrespective of it's current
encoding. For example the sequence:

    my $html1 = as html => $some_string;
    my $html2 = as html => $html1;

Does I<not> result in double encoding. The encodings you request are
'absolute'. A path of transformations that will convert the string from
whatever its current encoding is will be computed and applied.

=cut

sub as($$) {
  my ( $desired, $str ) = @_;

  my @desired
   = map { split /_/ } 'ARRAY' eq ref $desired ? @$desired : $desired;

  unless ( blessed $str && $str->isa( __PACKAGE__ ) ) {
    $str = bless { val => $str, rep => [] };
  }

  my @got_rep  = $str->rep;
  my @want_rep = @desired;

  # Prune common reps
  while ( @got_rep && @want_rep && $got_rep[0] eq $want_rep[0] ) {
    shift @got_rep;
    shift @want_rep;
  }

  $str = $str->{val};

  for my $spec ( [ 'from', reverse @got_rep ], [ 'to', @want_rep ] ) {
    my $dir = shift @$spec;
    for my $rep ( @$spec ) {
      my $handler = $rep_map{$rep} || croak "Don't know about $rep";
      $str = $handler->{$dir}->( $str );
    }
  }

  return bless {
    val => $str,
    rep => \@desired,
  };
}

=head2 C<< already >>

Declare that a string is already encoded in a particular way. For example:

    my $html = already html => '<p>This is a paragraph</p>';
    my $text =                 'This is just << some text >>';
    
    print literal html => $html;
    # already HTML encoded
    # prints
    #    <p>This is a paragraph</p>
    
    print literal html => $text;
    # applies HTML encoding
    # prints
    #   This is just &lt;&lt; some text &gt;&gt;

=cut

sub already($$) {
  return bless {
    val => $_[1],
    rep => [ map { split /_/ } 'ARRAY' eq ref $_[0] ? @$_[0] : $_[0] ]
  };
}