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

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

page 4 of 5



    $last_package = '';
    my $out;
    while (<$in>) {
	$fnr++;
	$in_pod = 1 if /^=\w/;
	$in_pod = 0 if /^=cut/;
	next if ($in_pod || /^=cut/);
	# the following (tempting) old coding gives big troubles if a
	# cut is forgotten at EOF:
	# next if /^=\w/ .. /^=cut/;
	if (/^package\s+([\w:]+)\s*;/) {
	    $this_package = $def_package = $1;
	}

	if (/^sub\s+([\w:]+)(\s*(?:\(.*?\))?(?:$attr_list)?)/) {
	    print $out "# end of $last_package\::$subname\n1;\n"
		if $last_package;
	    $subname = $1;
	    my $proto = $2 || '';
	    if ($subname =~ s/(.*):://){
		$this_package = $1;
	    } else {
		$this_package = $def_package;
	    }
	    my $fq_subname = "$this_package\::$subname";
	    $package{$fq_subname} = $this_package;
	    $proto{$fq_subname} = $proto;
	    push(@subnames, $fq_subname);
	    my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3));
	    $modpname = _modpname($this_package);
            my($modnamedir) = catdir($autodir, $modpname);
	    mkpath($modnamedir,0,0777);
	    my($lpath) = catfile($modnamedir, "$lname.al");
	    my($spath) = catfile($modnamedir, "$sname.al");
	    my $path;

	    if (!$Is83 and open($out, ">$lpath")){
	        $path=$lpath;
		print "  writing $lpath\n" if ($Verbose>=2);
	    } else {
		open($out, ">$spath") or die "Can't create $spath: $!\n";
		$path=$spath;
		print "  writing $spath (with truncated name)\n"
			if ($Verbose>=1);
	    }
	    push(@outfiles, $path);
	    my $lineno = $fnr - @cache;
	    print $out <<EOT;
# NOTE: Derived from $filename.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package $this_package;

#line $lineno "$filename (autosplit into $path)"
EOT
	    print $out @cache;
	    @cache = ();
	    $caching = 0;
	}
	if($caching) {
	    push(@cache, $_) if @cache || /\S/;
	} else {
	    print $out $_;
	}
	if(/^\}/) {
	    if($caching) {
		print $out @cache;
		@cache = ();
	    }
	    print $out "\n";
	    $caching = 1;
	}
	$last_package = $this_package if defined $this_package;
    }
    if ($subname) {
	print $out @cache,"1;\n# end of $last_package\::$subname\n";
	close($out);
    }
    close($in);
    
    if (!$keep){  # don't keep any obsolete *.al files in the directory
	my(%outfiles);
	# @outfiles{@outfiles} = @outfiles;
	# perl downcases all filenames on VMS (which upcases all filenames) so
	# we'd better downcase the sub name list too, or subs with upper case
	# letters in them will get their .al files deleted right after they're
	# created. (The mixed case sub name won't match the all-lowercase
	# filename, and so be cleaned up as a scrap file)
	if ($Is_VMS or $Is83) {
	    %outfiles = map {lc($_) => lc($_) } @outfiles;
	} else {
	    @outfiles{@outfiles} = @outfiles;
	}  
	my(%outdirs,@outdirs);
	for (@outfiles) {
	    $outdirs{File::Basename::dirname($_)}||=1;
	}
	for my $dir (keys %outdirs) {
	    opendir(my $outdir,$dir);
	    foreach (sort readdir($outdir)){
=4=

1|2|3| < PREV = PAGE 4 = NEXT > |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.00558591 wallclock secs ( 0.01 usr + 0.00 sys = 0.01 CPU)