588 implicit none
589 character(len = *), intent(in):: relative
590 character(len = *), intent(in):: base
591 character(len = STRING):: result
592 integer, parameter:: FILE = 1, var = 2, attr = 3, ior = 4
593 character(len = STRING):: rel(FILE:IOR), bas(FILE:IOR)
594 character(3), parameter:: PATHDELIM = "/:" // achar(94)
595 integer:: idir_r, idir_b
596 continue
597 call beginsub(
'urlresolve',
'rel=<%c> base=<%c>', c1=relative, c2=base)
598 call urlsplit(trim(relative), file=rel(file), var=rel(var), &
599 & attr=rel(attr), iorange=rel(ior))
600 call dbgmessage(
'rel -> file=<%c> var=<%c> attr=<%c>', &
601 & c1=trim(rel(file)), c2=trim(rel(var)), &
602 & c3=(trim(rel(attr)) // '> ior=<' // trim(rel(ior))))
603 call urlsplit(base, file=bas(file), var=bas(var), &
604 & attr=bas(attr), iorange=bas(ior))
605 call dbgmessage(
'base -> file=<%s> var=<%s> attr=<%s> ior=<%s>', &
606 & c1=trim(bas(file)), c2=trim(bas(var)), &
607 & c3=(trim(bas(attr)) // '> ior=<' // trim(bas(ior))))
608
609 if (rel(file) == "") then
610 rel(file) = bas(file)
611 if (rel(var) == "") &
612 & rel(var) = bas(var)
613 result = urlmerge(file=rel(file), var=rel(var), &
614 & attr=rel(attr), iorange=rel(ior))
615 call endsub(
'urlresolve',
'1 result=%c', c1=trim(result))
616 return
617 endif
618
619 if (
strhead(rel(file),
"file:") &
620 & .OR.
strhead(rel(file),
"http:") &
621 & .OR.
strhead(rel(file),
"ftp:") &
622 & .OR.
strhead(rel(file),
"news:") &
623 & .OR.
strhead(rel(file),
"www") &
624 & .OR.
strhead(rel(file),
"/") &
625 & .OR.
strhead(rel(file), achar(94)) &
626 & .OR. rel(file)(2:2) == ":" &
627 ) then
628 result = relative
629 call endsub(
'urlresolve',
'2 result=%c', c1=trim(result))
630 return
631 endif
632
633 idir_b = scan(bas(file), pathdelim, back=.true.)
634 if (idir_b == 0) then
635
636
637 result = relative
638 call endsub(
'urlresolve',
'3 result=%c', c1=trim(result))
639 return
640 endif
641
642 idir_r = scan(rel(file), pathdelim, back=.true.)
643 if (idir_r == 0) then
644
645 idir_r = 1
646 endif
647 result = base(1: idir_b) // relative(idir_r: )
648 call endsub(
'urlresolve',
'4 result=%c', c1=trim(result))
Handling character types.
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
Provides kind type parameter values.
integer, parameter, public string
Character length for string