libplaylist-perl/lib/Text/Playlist/M3U.pm

package Text::Playlist::M3U;

use strict;
use warnings;

our $VERSION = 0.1;

sub new {
  my ($class) = @_;

  return bless({ items => [], attrs => {}, }, $class);
}

sub items {
  my ($self) = @_;

  return wantarray ? @{$self->{items}} : $self->{items};
}

sub load {
  my ($self, $file) = @_;

  $self->{items} = [];

  open(my $FH, "<", $file) or return $!;
  my @lines = <$FH>;
  close($FH);
  chomp for @lines;

  # safeguard
  return "Not looks like playlist"
    unless grep { $_ =~ m/^#EXTM3U/o } @lines;

  my $item = undef;
  foreach my $line (@lines) {
    # header
    if ($line =~ m/#EXTM3U(\s+\S+?=\S+)*/oi) {
      return "Multiple EXTM3U lines found"
        if (scalar keys($self->{attrs}));
      $self->{attrs} = $self->_parse_attrs($1);
    }
    # standart tags
    if ($line =~ m/^\s*#EXTINF:(-?\d+(?:\.\d+)?)(\s+\S+?=\S+)*,(.*)/oi) {
      $item //= {
        duration => $1,
        attrs    => $self->_parse_attrs($2),
        title    => $3,
      };
    }
    # extended tags
    if ($line =~ m/^\s*#EXT-X-\S+?:(\s*\S+?=\S+)/oi) {
      # ignore
    }
    # comments
    if ($line =~ m/^\s*#/) {
      next;
    }
    # path / url
    if ($line) {
      $item->{file} = $line;
      push @{$self->{items}}, $item;
      undef $item;
    }
  }

  return $self->items;
}

sub _parse_attrs {
  my ($self, $str) = @_;

  return {} unless $str;
  my %attrs = ();
  $str =~ s/(^\s+|\s+$)//oi;
  foreach my $token (split /\s+/, $str) {
    my ($key, $value) = split("=", $token, 2);
    $attrs{$key} = $value;
  }

  return \%attrs;
}

sub _dump_attrs {
  my ($self, $attrs) = @_;
  my @parts = ('');

  while (my ($key, $value) = each %{$attrs}) {
    push @parts, sprintf("%s=%s", $key, $value);
  }
  return @parts ? join(" ", @parts) : "";
}

sub dump {
  my ($self) = @_;
  my @lines = ();
  push @lines, sprintf('#EXTM3U%s', $self->_dump_attrs($self->{attrs}));

  foreach my $item ($self->items) {
    push @lines, sprintf("#EXTINF:%s%s,%s", $item->{duration},
         $self->_dump_attrs($item->{attrs}), $item->{title});
    push @lines, $item->{file};
  }

  push @lines, '';
  return join("\n", @lines);
}

sub save {
  my ($self, $file) = @_;

  open(my $FH, ">", $file) or die $!;
  print $FH $self->dump();
  close($FH);

  return 1;
}

1;