view release on metacpan or  search on metacpan

lib/Net/DAAP/DMAP.pm  view on Meta::CPAN

            my ($n1, $n2) = unpack("N2", $data);
            $data = new Math::BigInt(new Math::BigInt($n1)->blsft(32));
            $data += $n2;
            $data = "$data";
        } else {
            $data = unpack($Type_To_Unpack{$type}, $data);
        }
        # type 9 is really utf-8 encoded, so if we can, show that it is
        if ($type == 9 && eval { require Encode; 1 }) {
            $data = Encode::decode('utf-8', $data);
        }
        push @tags, [ $Types->{$tag}{NAME}, $data ];
    }

    return \@tags;
}

sub dmap_to_xml {
    my $buf = shift;
    my $xml = '';

    while (length $buf) {
        my ($tag, $len) = unpack("a4N", $buf);
        my $data = substr($buf, 8, $len);
        my $type = $Types->{$tag}{TYPE};

        if ($type == 12) {
            $data = dmap_to_xml($data);
        } else {
            $data = unpack($Type_To_Unpack{$type}, $data);
        }
        $xml .= sprintf("<%s>\n  %s\n</%s>\n", $tag, $data, $tag);
        substr($buf, 0, 8+$len) = '';
      }
    return $xml;
}

sub dmap_to_array_ref {
    my $buf = shift;
    my @tags;

    while (length $buf) {
        my ($tag, $len) = unpack("a4N", $buf);
        if (!defined($len) or length $buf < 8+$len) {
            return;
          }
        my $data = substr($buf, 8, $len);
        # try to unpack, assume it was a container if it succeeded
        my $data2 = dmap_to_array_ref($data);
        push @tags, [ $tag,  $data2 ? $data2 : $data ];
        substr($buf, 0, 8+$len) = '';
      }
    return \@tags;
}

sub dmap_seek {
    my($struct, $to_find) = @_;

    CHUNK: while (defined($to_find) && length($to_find)) {
        my $top;
        ($top, $to_find) = split m{/}, $to_find, 2;

      ELEMENT: foreach my $elt (@$struct) {

          if ($elt->[0] eq $top) {
                $struct = $elt->[1];
                next CHUNK;
            }
        }
        return;  # NOT FOUND
    }
    return $struct;
}

sub update_content_codes {
  my $array = shift;
  my $short;

  my $mccr = dmap_seek($array, "dmap.contentcodesresponse");
  die "Couldn't find mccr" unless defined $mccr;

  foreach my $mdcl_rec (@$mccr) {
    next unless $mdcl_rec->[0] eq 'dmap.dictionary';
    my @fields = @{$mdcl_rec->[1]};
    my ($name, $id, $type);
    foreach my $f (@fields) {
      if ($f->[0] eq 'dmap.contentcodesnumber') { $id = $f->[1] }
      if ($f->[0] eq 'dmap.contentcodesname') { $name = $f->[1] }
      if ($f->[0] eq 'dmap.contentcodestype') { $type = $f->[1] }
    }
    if ($id eq 'mcnm') { $type = 9  } # string names please
    if ($id eq 'pfdt') { $type = 42 } # and straight binary pictures
    my $record = { NAME => $name, ID => $id, TYPE => $type };
    $short->{$id} = $record;
  }

  $Types = $short;
}

sub dmap_pack {
    my $struct = shift;
    my $out = '';

    my %by_name = map { %{$_} ? ( $_->{NAME} => $_ ) : () } values %$Types;
    for my $pair (@$struct) {
        my ($name, $value) = @$pair;
        # dmap_unpack doesn't populate the name when its decoded
        # something it doesn't know the content-code of, like aeSV
        # which is new to 4.5
        unless ($name) {
            carp "element without a name - skipping" if $NOISY;
            next;
        }
        # or, it may be we don't know what kind of thing this is
        unless ($by_name{ $name }) {
            carp "$name has unknown type - skipping" if $NOISY;
            next;
        }

        my $tag  = $by_name{ $name }{ID};
        my $type = $by_name{ $name }{TYPE};