view release on metacpan or  search on metacpan

bin/mfile-www  view on Meta::CPAN

    } elsif ( $distro =~ m/\-/ ) {
        @tmp_c = split( '-', $distro );
    } else {
        @tmp_c = ( $distro );
    }
    my $app_distro = join( '-', @tmp_c );
    my $module = join( '::', @tmp_c );
    my $app_module = $module . '::Dispatch';
    die "$app_module is not a module name" unless is_module_name( $app_module );
    print "_get_sharedir: Derived distro is $app_distro\n";

    my $status = undef;
    try {
        require_module( $app_module );
    } catch {
        $status = "Module $app_module cannot be found. Bailing out!";
    };
    die $status if $status;

    my $distro_sharedir;
    $status = undef;
    try {
        $distro_sharedir = File::ShareDir::dist_dir( $app_distro );
    } catch {
        $status = "Could not find a sharedir for distro $app_distro: $_";
    };
    die $status if $status;

    return ( $app_distro, $app_module, $distro_sharedir );
}

sub _symlink_paths {
    my ( $ddir ) = @_;
    # set up "old" and "new" state variables for our symlinks
    state $old_css = File::Spec->catfile( $mfile_sharedir, 'css' );
    state $new_css = File::Spec->catfile( $ddir, 'css' );
    state $old_corejs = File::Spec->catfile( $mfile_sharedir, 'js', 'core' );
    state $new_corejs = File::Spec->catfile( $ddir, 'js', 'core' );

    return ( 
        old_css => $old_css,
        new_css => $new_css,
        old_corejs => $old_corejs,
        new_corejs => $new_corejs,
    );
}
 
sub _symlinks_exist {
    my ( $ddir ) = @_;
    my %sp = _symlink_paths( $ddir );
    # check if the "new" already exist and are symlinks
    return ( -l $sp{new_css} and -l $sp{new_corejs} );
}
    
sub _create_symlink {
    my ( $old, $new ) = @_;
    die "Need to be root to create symlink" unless $sharedir_writable;
    my ( undef, $path, $file ) = File::Spec->splitpath( $new );
    make_path( $path );
    symlink( $old, $new ) ;
    if ( ! stat( $new ) ) {
        unlink( $new );
        die "Could not create symlink $old -> $new";
    }
    return;
}

#
# MAIN
#
print "App::MFILE::WWW ver. $VERSION\n";

my $init = '';
my $ddist = '';
my $sitedir = '';
my $http_root;

# Report the result
print "Running as ";
print "root\n" if $sharedir_writable;
print "a normal user\n" if not $sharedir_writable;

# determine if we are running in standalone or derived distribution mode
GetOptions(
    'ddist=s' => \$ddist,
    'init' => \$init,
    'sitedir=s' => \$sitedir,
);

# if the user as specified a derived distribution, we might be running in
# derived distribution mode
if ( $ddist ) {

    ( $ddist_distro, $dispatch_module, $ddist_sharedir ) = _get_sharedir( $ddist );
    print "Derived distro is $ddist_distro\n";
    print "Derived distro sharedir is $ddist_sharedir\n";

    # in derived distro mode, we need symlinks; check if they exist
    if ( ! _symlinks_exist( $ddist_sharedir ) ) {
        print "\$sharedir_writable == $sharedir_writable\n";
        if ( ! $sharedir_writable ) {
            print "Symlinks not present and sharedir not writable: run the script again as root with --init\n";
            exit;
        }
        if ( $init ) {
            # if unsuccessful, the _create_symlink routine will die and attempt
            # to clean up after itself
            my %sp = _symlink_paths( $ddist_sharedir );
            _create_symlink( $sp{old_css}, $sp{new_css} );
            _create_symlink( $sp{old_corejs}, $sp{new_corejs} ); 
        } else {
            print "--init not given; not creating symlinks";
        }
    }

    print "Symlinks are OK";

    # symlinks are OK, but if running with --init we can't continue
    if ( $init ) {
        print "; now run the script again as a normal user without the --init option\n";
        exit;