PROXY  WHOIS  RQUOTE  TEXTS  SOFT  FOREX  BBOARD
 Music  Philosophy  Code  Literature  Russian

= ROOT|Technical|Code_Examples|Perl|lib|AutoSplit.pm =

page 3 of 5




# private functions

my $self_mod_time = (stat __FILE__)[9];

sub autosplit_file {
    my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time)
	= @_;
    my(@outfiles);
    local($_);
    local($/) = "\n";

    # where to write output files
    $autodir ||= catfile(curdir(), "lib", "auto");
    if ($Is_VMS) {
	($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/\z||;
	$filename = VMS::Filespec::unixify($filename); # may have dirs
    }
    unless (-d $autodir){
	mkpath($autodir,0,0755);
	# We should never need to create the auto dir
	# here. installperl (or similar) should have done
	# it. Expecting it to exist is a valuable sanity check against
	# autosplitting into some random directory by mistake.
	print "Warning: AutoSplit had to create top-level " .
	    "$autodir unexpectedly.\n";
    }

    # allow just a package name to be used
    $filename .= ".pm" unless ($filename =~ m/\.pm\z/);

    open(my $in, "<$filename") or die "AutoSplit: Can't open $filename: $!\n";
    my($pm_mod_time) = (stat($filename))[9];
    my($autoloader_seen) = 0;
    my($in_pod) = 0;
    my($def_package,$last_package,$this_package,$fnr);
    while (<$in>) {
	# Skip pod text.
	$fnr++;
	$in_pod = 1 if /^=\w/;
	$in_pod = 0 if /^=cut/;
	next if ($in_pod || /^=cut/);
        next if /^\s*#/;

	# record last package name seen
	$def_package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
	++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/;
	++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/;
	last if /^__END__/;
    }
    if ($check_for_autoloader && !$autoloader_seen){
	print "AutoSplit skipped $filename: no AutoLoader used\n"
	    if ($Verbose>=2);
	return 0;
    }
    $_ or die "Can't find __END__ in $filename\n";

    $def_package or die "Can't find 'package Name;' in $filename\n";

    my($modpname) = _modpname($def_package); 

    # this _has_ to match so we have a reasonable timestamp file
    die "Package $def_package ($modpname.pm) does not ".
	"match filename $filename"
	    unless ($filename =~ m/\Q$modpname.pm\E$/ or
		    ($^O eq 'dos') or ($^O eq 'MSWin32') or ($^O eq 'NetWare') or
	            $Is_VMS && $filename =~ m/$modpname.pm/i);

    my($al_idx_file) = catfile($autodir, $modpname, $IndexFile);

    if ($check_mod_time){
	my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
	if ($al_ts_time >= $pm_mod_time and
	    $al_ts_time >= $self_mod_time){
	    print "AutoSplit skipped ($al_idx_file newer than $filename)\n"
		if ($Verbose >= 2);
	    return undef;	# one undef, not a list
	}
    }

    my($modnamedir) = catdir($autodir, $modpname);
    print "AutoSplitting $filename ($modnamedir)\n"
	if $Verbose;

    unless (-d $modnamedir){
	mkpath($modnamedir,0,0777);
    }

    # We must try to deal with some SVR3 systems with a limit of 14
    # characters for file names. Sadly we *cannot* simply truncate all
    # file names to 14 characters on these systems because we *must*
    # create filenames which exactly match the names used by AutoLoader.pm.
    # This is a problem because some systems silently truncate the file
    # names while others treat long file names as an error.

    my $Is83 = $maxflen==11;  # plain, case INSENSITIVE dos filenames

    my(@subnames, $subname, %proto, %package);
    my @cache = ();
    my $caching = 1;
=3=

1|2| < PREV = PAGE 3 = NEXT > |4|5

UP TO ROOT | UP TO DIR | TO FIRST PAGE

Google
 


E-mail Facebook Google Digg del.icio.us BlinkList Fark Furl Ma.gnolia Netscape NewsVine Reddit Slashdot Spurl StumbleUpon Technorati YahooMyWeb LiveJournal Blogmarks TwitThis Live News2.ru BobrDobr.ru Memori.ru MoeMesto.ru

0.00828505 wallclock secs ( 0.01 usr + 0.00 sys = 0.01 CPU)