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

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

page 5 of 5



		next unless /\.al\z/;
		my($file) = catfile($dir, $_);
		$file = lc $file if $Is83 or $Is_VMS;
		next if $outfiles{$file};
		print "  deleting $file\n" if ($Verbose>=2);
		my($deleted,$thistime);  # catch all versions on VMS
		do { $deleted += ($thistime = unlink $file) } while ($thistime);
		carp "Unable to delete $file: $!" unless $deleted;
	    }
	    closedir($outdir);
	}
    }

    open(my $ts,">$al_idx_file") or
	carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
    print $ts "# Index created by AutoSplit for $filename\n";
    print $ts "#    (file acts as timestamp)\n";
    $last_package = '';
    for my $fqs (@subnames) {
	my($subname) = $fqs;
	$subname =~ s/.*:://;
	print $ts "package $package{$fqs};\n"
	    unless $last_package eq $package{$fqs};
	print $ts "sub $subname $proto{$fqs};\n";
	$last_package = $package{$fqs};
    }
    print $ts "1;\n";
    close($ts);

    _check_unique($filename, $Maxlen, 1, @outfiles);

    @outfiles;
}

sub _modpname ($) {
    my($package) = @_;
    my $modpname = $package;
    if ($^O eq 'MSWin32') {
	$modpname =~ s#::#\\#g; 
    } else {
	my @modpnames = ();
	while ($modpname =~ m#(.*?[^:])::([^:].*)#) {
	       push @modpnames, $1;
	       $modpname = $2;
         }
	$modpname = catfile(@modpnames, $modpname);
    }
    if ($Is_VMS) {
        $modpname = VMS::Filespec::unixify($modpname); # may have dirs
    }
    $modpname;
}

sub _check_unique {
    my($filename, $maxlen, $warn, @outfiles) = @_;
    my(%notuniq) = ();
    my(%shorts)  = ();
    my(@toolong) = grep(
			length(File::Basename::basename($_))
			> $maxlen,
			@outfiles
		       );

    foreach (@toolong){
	my($dir) = File::Basename::dirname($_);
	my($file) = File::Basename::basename($_);
	my($trunc) = substr($file,0,$maxlen);
	$notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc};
	$shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ?
	    "$shorts{$dir}{$trunc}, $file" : $file;
    }
    if (%notuniq && $warn){
	print "$filename: some names are not unique when " .
	    "truncated to $maxlen characters:\n";
	foreach my $dir (sort keys %notuniq){
	    print " directory $dir:\n";
	    foreach my $trunc (sort keys %{$notuniq{$dir}}) {
		print "  $shorts{$dir}{$trunc} truncate to $trunc\n";
	    }
	}
    }
}

1;
__END__

# test functions so AutoSplit.pm can be applied to itself:
sub test1 ($)   { "test 1\n"; }
sub test2 ($$)  { "test 2\n"; }
sub test3 ($$$) { "test 3\n"; }
sub testtesttesttest4_1  { "test 4\n"; }
sub testtesttesttest4_2  { "duplicate test 4\n"; }
sub Just::Another::test5 { "another test 5\n"; }
sub test6       { return join ":", __FILE__,__LINE__; }
package Yet::Another::AutoSplit;
sub testtesttesttest4_1 ($)  { "another test 4\n"; }
sub testtesttesttest4_2 ($$) { "another duplicate test 4\n"; }
package Yet::More::Attributes;
sub test_a1 ($) : locked :locked { 1; }
sub test_a2 : locked { 1; }
=5=

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

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.0335569 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU)