view release on metacpan or  search on metacpan

lib/App/Followme/FIO.pm  view on Meta::CPAN

		
		$data = \@buffer;
	}
	
	if (ref($data) eq 'ARRAY') {
		my @buffer;
		foreach my $value (@$data) {
			push(@buffer, fio_flatten($value));
		}
		
		$data = join(", ", @buffer);
	}
	
	return $data;
}

#----------------------------------------------------------------------
# Format a date string

sub fio_format_date {
    my ($date, $format) = @_;
    
    $format = 'yyyy-mm-ddThh:mm:ss' unless defined $format;
    $date = time_format($format, $date);
    return $date;
}

#----------------------------------------------------------------------
# Construct the full file name from a relative file name

sub fio_full_file_name {
    my (@directories) = @_;

    return $directories[-1] if file_name_is_absolute($directories[-1]);

    my @dirs;
    foreach my $dir (@directories) {
        push(@dirs, splitdir($dir));
    }

    my @new_dirs;
    foreach my $dir (@dirs) {
        if (no_upwards($dir)) {
            push(@new_dirs, $dir);
        } else {
            pop(@new_dirs) unless $dir eq '.';
        }
    }

    return catfile(@new_dirs);
}

#----------------------------------------------------------------------
# Get modification date of file

sub fio_get_date {
    my ($filename) = @_;

    my $date;
    if (-e $filename) {
        my @stats = stat($filename);
        $date = $stats[9];
    } else {
        $date = time();
    }

    return $date;
}

#----------------------------------------------------------------------
# Get size of file

sub fio_get_size {
    my ($filename) = @_;

    my $size;
    if (-e $filename) {
        my @stats = stat($filename);
        $size = $stats[7];
    } else {
        $size = 0;
    }

    return $size;
}

#----------------------------------------------------------------------
# Map filename globbing metacharacters onto regexp metacharacters

sub fio_glob_patterns {
    my ($patterns) = @_;
    my @globbed_patterns = ();

    if ($patterns) {
        my @patterns = split(/\s*,\s*/, $patterns);

        foreach my $pattern (@patterns) {
            if ($pattern eq '*') {
                push(@globbed_patterns,  '.');

            } else {
                my $start;
                if ($pattern =~ s/^\*//) {
                    $start = '';
                } else {
                    $start = '^';
                }

                my $finish;
                if ($pattern =~ s/\*$//) {
                    $finish = '';
                } else {
                    $finish = '$';
                }

                $pattern =~ s/\./\\./g;
                $pattern =~ s/\*/\.\*/g;
                $pattern =~ s/\?/\.\?/g;

                push(@globbed_patterns, $start . $pattern . $finish);
            }
        }
    }

    return \@globbed_patterns;
}

#----------------------------------------------------------------------
# Is the target newer than any source file?

sub fio_is_newer {
    my ($target, @sources) = @_;

    my $target_date = -e $target ? fio_get_date($target) : 0;

    foreach my $source (@sources) {
        next unless defined $source;