How to make perl regex options conditional

DON'T ASK WHY but...

I have a regex that needs to be case insensitive if run on windows BUT case sensitive when run on *nix.

Here is an example snippet of what I am kind-of doing at the moment.

sub relative_path 
{
    my ($root, $path) = @_;

    if ($os eq "windows")
    {
        # case insensitive with regex option 'i'
        if ($path !~ /^\Q$root\E[\\\/](.*)$/i)
        {
            print "\tFAIL:$root not in $path\n";
        }
        else
        {
            return $1;
        }
    }
    else
    {
        # case sensitive
        if ($path !~ /^\Q$root\E[\\\/](.*)$/)
        {
            print "\tFAIL:$root not in $path\n";
        }
     开发者_StackOverflow社区   else
        {
            return $1;
        }
    }
    return "";
}

Argh! The repetition hurts my OCD but my perl-fu is weak. Somehow I want to make the regex option 'i' for case-insensitive conditional but I don't now how?

You can use an extended construct to specify the option. For example:

#!/usr/bin/env perl

use warnings; use strict;

my $s = 'S';

print check($s, 'i'), "\n";
print check($s, '-i'), "\n";

sub check {
    my ($s, $opt) = @_;
    return "Matched" if $s =~ /(?$opt)^s\z/;
    return "Did not match";
}

See perldoc perlre.

You can create patterns and store them in scalars using the qr operator:

sub relative_path 
{
    my ($root, $path) = @_;

    my $pattern = ($os eq "windows") ? qr/^\Q$root\E[\\\/](.*)$/i : qr/^\Q$root\E[\\\/](.*)$/;

    if ($path !~ $pattern)
    {
        print "\tFAIL:$root not in $path\n";
    }
    else
    {
        return $1;
    }
}

This might not be 100% perfect, but hopefully you should get the idea.

Make sure to check out the section "Quote and Quote-Like Operators" in perlop.

EDIT: Okay, here's a DRY solution since people are complaining about it.

sub relative_path 
{
    my ($root, $path) = @_;

    my $base_pattern = qr/^\Q$root\E[\\\/](.*)$/;
    my $pattern = ($os eq "windows") ? qr/$base_pattern/i : $base_pattern;

    if ($path !~ $pattern)
    {
        print "\tFAIL:$root not in $path\n";
    }
    else
    {
        return $1;
    }
}

In addition to achieving the stated objective, this properly handles volumes unlike the regex patterns previously posted.

use Path::Class qw( dir );

sub relative_path {
   my ($root, $path) = @_;

   if ($^O =~ /Win32/) {
      require Win32;
      $root = Win32::GetLongPathName($root);
      $path = Win32::GetLongPathName($path);
   }

   $root = dir($root);
   $path = dir($path);

   if ($root->subsumes($path)) {
      return $path->relative($root);
   } else {
      print "\tFAIL:$root not in $path\n";
      return "";
   }
}

By the way, it's not very appropriate to handle the error there. The function should return an error signal (return undef, throw an exception, etc) and the caller should handle it as it sees fit. Separations of concerns.

You can also do it using local modifiers (perl extended regexes option):

sub relative_path 
{
    my ($root, $path) = @_;

    my $pattern = "^\Q$root\E[\\\/](.*)$";
    $pattern = "(?i)$pattern" if ($os eq "windows");
    if ($path =~ /$pattern/)
    {
        return $1;
    }
    else
    {
        print "\tFAIL:$root not in $path\n";
    }
}

(after I typed my answer I saw that Sinan also suggested it, but I decided to post my answer as well, since it gives a concreter answer to the question)