view release on metacpan or  search on metacpan

lib/App/SD/CLI/Command/Publish.pm  view on Meta::CPAN

		    $self->handle_redirect( $dir, $file, $new_file );
		    unshift @links, $new_file;
		} elsif ($_) { # rethrow
		    die $_;
		}
	    };
        }
    }
}

sub work_with_urls {
    my $self     = shift;
    my $current_url = shift;
    my $content  = shift;

    my $current_depth = () = $current_url =~ m{.+?/}g;

    #Extract Links from the file
    my $h = HTML::TreeBuilder->new;
    $h->no_space_compacting(1);
    $h->ignore_ignorable_whitespace(0);
    $h->parse_content($content);

    my $link_elements = $h->extract_links(qw(img href script style a link ));
    return ($content, []) unless @$link_elements;

    my $all_links = {};

    #Grab each img src and re-write them so they are relative URL's
    foreach my $link_element (@$link_elements) {

        my $link    = shift @$link_element;    #URL value
        my $element = shift @$link_element;    #HTML::Element Object

        $all_links->{$link}++;
        
        my $url = $link;

        if ( $url =~ m|/$| ) {
            $url .= "index.html" 
        } elsif ($url !~ /\.\w{2,4}$/) {
            $url .= ".html";
        }

        # if $url is absolute, let's make it relative
        if ( $url =~ s{^/}{} && $current_depth ) {
            $url = ( '../' x $current_depth ) . $url;
        }

        my ($attr)
            = grep { defined $element->attr($_) and $link eq $element->attr($_) }
            @{ $HTML::Tagset::linkElements{ $element->tag } };

        $element->attr( $attr, $url );
    }

    my @links;

    # we nned to turn every link into absolute, here is to find out dir info
    # e.g. if $current_url is '/foo/bar/baz.html', @dirs will be qw/foo bar/
    my @dirs = grep { $_ } split m{/}, $current_url;
    # pop the page name like history.html
    pop @dirs;

    for my $link ( keys %$all_links ) {
        next unless $link;

        # we don't use ./ and file: link in pages, so they are bogus for us
        # more worse thing is './' will overwride some page with nothing
        next if $link eq './' || $link =~ /^file:/;

        # generally, if the link is not absolute, we need to find it.
        if ( $link !~ m{^/} ) {
            my $depth = $link =~ s{\.\./}{}g;
            my @tmp_dirs = @dirs;
            # remove trailing dirs according to $depth
            if ($depth) {
                pop @tmp_dirs while $depth--;
            }
            $link = '/' . join '/', @tmp_dirs, $link;
        }

        push @links, $link;
    }

    return $h->as_HTML, \@links;
}

sub handle_redirect {
    my $self            = shift;
    my $dir             = shift;
    my $file            = shift;
    my $new_file        = shift;
    my $redirected_from = File::Spec->catfile( $dir => $file );
    my $redirected_to   = File::Spec->catfile( $dir => $new_file );
    {
        my $parent = Prophet::Util->updir($redirected_from);
        # mkpath succeeds (but returns nothing) if a directory already exists
        eval { mkpath( [$parent] ) };
        if ( $@ ) {
            die "Failed to create directory " . $parent . " - for $redirected_to " . $@;
        }
    }
    if ( -d $redirected_from ) { $redirected_from .= "/index.html"; }
    link( $redirected_to, $redirected_from );
}

sub write_file {
    my $self    = shift;
    my $dir     = shift;
    my $file    = shift;
    my $content = shift;

    if ( $file =~ qr|/$| ) {
        $file .= "index.html" 
    } elsif ($file !~ /\.\w{2,4}$/) {
        $file .= ".html";
    }
    Prophet::Util->write_file( file => File::Spec->catfile( $dir => $file ), content => $content );

}