ReaScriptLib.pm

From CockosWiki

Jump to: navigation, search

ReaScriptLib.pm

This would be nice but, unfortunately, won't work until ReaScript is implemented in the standard way. Left here in hope :)

#
# ReaScriptLib.pm
#
 
#
# Rev When       Who           What
# --- ---------- ------------- -------------------------------------------------
# 001 24/11/2009 Mike Lacey    Original version,
#                               define and export extract_section()
#
 
package ReaScriptLib;
 
use strict;
use warnings;
 
# Module initialisation code. On compile.
BEGIN {
    use Exporter   ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION     = 0.01;
    @ISA         = qw(Exporter);
    @EXPORT      = qw(&extract_section);
    %EXPORT_TAGS = ();
    @EXPORT_OK   = qw(); # exported globals and optionally exported functions
}
our @EXPORT_OK;
 
# prototypes
sub extract_section($$$);
 
# extract_section($chunk, $name, $index)
# params
#  chunk,       chunk as returned from an RPR_GetSet*State function
#  name,        section name <SEC_NAME or P_NAME, multi or single line
#  index        the occurance of "name" to be extracted. So to pick up, say
#               the first ITEM in a track
#                -- name would be set to '<ITEM'
#                -- index would be set to 0, or to 1 for the second and so on.
#
# returns (
#  before_section,  the part of chunk before "section"
#  section,         the section itself
#  after_section    the part of chunk after "section"
# )
#
sub extract_section($$$){ my($chunk, $name, $index) = @_;
 
my @chunk;                      # to hold $chunk split into lines
my $cline;                      # individual lines from @chunk
my $indent;                     # to keep track in a multiline section
my ($before, $section, $after); # return values
my $inner_state = 0;            # 0=before section, 1=in section, 2=after
my $multiline = 0;              # boolean, single line sections have no <
my $occurrence = 0;
 
    $multiline = 1 if $name =~ /^</;            # a multiline section?
 
    $before = $section = $after = '';           # just in case
 
    @chunk = split(/\n/,$chunk);                # populate @chunk
    foreach $cline (@chunk){                    # and loop through it
        if($inner_state == 0){                  # "before" section
            if($cline =~ /^\s+$name/){
                # correct section name - correct occurrence?
                if($occurrence == $index){      # Yes
                    $indent++;                  # keep track of indents
                    $inner_state = 1;           # might be multiline...
                    $section .= "$cline\n";     # build up return variable
                    $inner_state = 2            # done unless
                        unless $multiline;      # it's a multiline section
                } else {                        # No, wrong occurrence
                    $occurrence++;              # keep looking
                                                # (unless already past it)
                    last if $occurrence > $index;
                }
            } else {
                # still before the section we're looking for
                $before .= "$cline\n";          # so build up return variable
            }
        } elsif($inner_state == 1){             # in a multiline section
            $section .= "$cline\n";             # so build up return variable
            $indent++ if $cline =~ /</;         # keep track of indents
            $indent-- if $cline =~ />/;         # keep track of indents
            $inner_state = 2 if $indent == 0;   # and get out if we're done
        } elsif($inner_state == 2){             # "after" section
            $after .= "$cline\n";               # so build up return variable
        }
    }
    return($before, $section, $after);
}
 
END { }       # module clean-up code
 
# Initialisation code, on run
1;  # return a TRUE value from the package initialisation