view release on metacpan or  search on metacpan

supertag  view on Meta::CPAN

}

sub scan_filename {
  my $file = shift;
  my $pattern = shift;
  my $delim = '_';
  my @match_names;
 
  $pattern =~ s!([^a-zA-Z0-9_ %.*/-])!\\$1!g;
  $pattern =~ s/%([a-zA-Z])/push @match_names, $tag_abbrev{$1}; "(.*?)"/eg;

  for my $try ($file, basename($file)) {
    if ((my @matches = ($try =~ qr/$pattern/))) {
      my %tags;

      for (my $i=0; $i<@matches; $i++) {
        $tags{$match_names[$i]} = $matches[$i];
      }

      return \%tags;
    }
  }

  return {};
}

sub format_filename {
  my $pattern = shift;
  my $tags = shift;

  my $specsub = sub {
    my ($width, $format) = @_;
    my $value = $tags->{$tag_abbrev{$format}};
    my $type;

    $width = '' if not defined $width;
    $value = '' if not defined $value;
    $type = $format eq 'T' ? 'd' : 's';

    return sprintf "%${width}${type}" => path_sanitize($value);
  };

  my $file = $pattern;
  $file =~ s/%(\d*)([a-zA-Z])/$specsub->($1,$2)/ge;
  return $file;
}

sub path_sanitize {
  my $str = shift;

  # TODO crib odd char set from soundjuicer?
  $str =~ s! !_!g;
  $str =~ s![^[:print:]]!_!g;
  $str =~ s![/\\\*:]!_!g;

  return $str;
}

sub ensure_dir {
  my $dir = shift;
  my @parts = split m{/} => $dir;
  my $x = '';

  while (@parts) {
    $x .= '/' . shift @parts;
    if ($x && !-d $x) {
      mkdir $x or $!{EEXIST} or do die "mkdir error for $x: $!";
    }
  }
}

sub trace {
  my $threshold = shift;
  my $level = shift;

  if ($level >= $threshold) {
    my $msg = join "\n" => @_;
    $msg .= "\n" unless substr($msg, -1, 1) eq "\n";
    print $msg;
  }
}

sub dirname {
  return $1 if $_[0] =~ m{^(.+)/([^/]+)$};
  return;
}

sub basename {
  return $_[0] =~ m{([^/]+)$} ? $1 : $_[0];
}

sub scan_tabular {
  return map { s/%(\d\d)/chr(hex($1))/ge; $_ } 
    split /\|/ => $_[0];
}

sub scan_editable {
  return map { s/%(\d\d)/chr(hex($1))/ge; $_ }
    map split( /: /, $_, 2 ) =>
      split /\n/ => $_[0];
}

sub format_tabular {
  return join "|" =>
    map { s/([^[:print:]]|%|\|)/"%".sprintf('%02x',ord($1))/ge; $_ } @_;
}

sub format_editable {
  my %h = @_;

  for (keys %h) {
    $h{$_} = '' unless defined $h{$_};
    $h{$_} =~ s/([^[:print:]]|%|\n)/"%".sprintf('%02x',ord($1))/ge;
  }

  return join "\n" => map "$_: $h{$_}" => sort keys %h;
}

sub hash_union {
  my %h;