File::Corresponding::File::Profile - The definition of what matches

File-Corresponding documentation

Contained in the File-Corresponding distribution.

Index

NAME
PROPERTIES
METHODS
- matching_file_fragment($file) : ($file_base, $file_fragment) | ()
- new_found_if_file_exists($matching_profile, $file_base, $fragment) : File::Found | ()
SUBROUTINES
- rex_from_qr($rex_string) : RegexRef

Code Index:

package File::Corresponding::File::Profile
__END__
EOF

NAME

File::Corresponding::File::Profile - The definition of what matches and translates to corresponding files

PROPERTIES

name

Name/description of this file profile.

sprintf

sprintf string to construct a file name. It should contain at least one % command to insert a relative file name.

Only used if defined.

regex : RegexRef

Regex matching a file. The first capture parens are used to extract the local file name.

If coerced from a string, define as qr$regex, i.e. specify the delimiters and any needed flags.

METHODS

matching_file_fragment($file) : ($file_base, $file_fragment) | ()

Return two item list with (the base filename, the captured file name fragment) from matching $file against regex, or () if nothing matched.

The $file_base is the $file, but with the whole matching regex removed, forming the basis for looking up corresponding files.

new_found_if_file_exists($matching_profile, $file_base, $fragment) : File::Found | ()

Return a new File::Corresponding::File::Found object if a file made up of $file_base, this profile, and $fragment exists in the filesystem.

If not, return ().

SUBROUTINES

rex_from_qr($rex_string) : RegexRef

Convert $rex_string to a proper Regex ref, or die with a useful error message.

File-Corresponding documentation

Contained in the File-Corresponding distribution.

use strict;
package File::Corresponding::File::Profile;
use Moose;

use Moose::Util::TypeConstraints;
use Data::Dumper;
use Path::Class;

use File::Corresponding::File::Found;

has 'name' => (is => 'ro', isa => 'Str', default => "");

has 'sprintf' => (is => 'ro', isa => 'Maybe[Str]');

subtype RegexRef
        => as RegexpRef
        => where { ref($_) eq "Regexp" };  #print "JPL: where: ($_) (" . ref($_) . ")\n"; 
coerce RegexRef
        => from 'Str'
        => via { regex_from_qr($_) };

has 'regex' => (
    is       => 'rw',
    isa      => 'RegexRef',
    coerce   => 1,
    required => 1,
);

sub matching_file_fragment {
    my $self = shift;
    my ($file) = @_;
    my $regex = $self->regex;
    
    my $file_base = $file;
    $file_base =~ s/$regex// and return ($file_base, $1);
    
    return ();
}

sub new_found_if_file_exists {
    my $self = shift;
    my ($matching_profile, $file_base, $fragment) = @_;
    my $sprintf = $self->sprintf or return ();

    my $file = file($file_base, sprintf($sprintf, $fragment));

    -e $file or return ();
    
    return File::Corresponding::File::Found->new({
        file             => $file,
        matching_profile => $matching_profile,
        found_profile    => $self,
    });
}

sub regex_from_qr {
    my ($rex_string) = @_;
    my $rex = eval "qr $rex_string";
    $@ and die("Could not parse regexp ($rex_string):
$@
Correct regex syntax is e.g. '/ prove [.] bat /x'
");
    return $rex;
}



1;



__END__