DataMuseum.dk

top - metrics - download

    Length: 96768 (0x17a00)
    Types: TextFile
    Names: »datonavntx  «

└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
    └─⟦a957ba283⟧ 
        └─⟦this⟧ »datonavntx  « 

TextFile

begin message datonavn, side 1 - 800117/cl;

<* programmet omdøber en eller flere katalogindgange til
   navne på formen:
           <prefix><dato-tid><postfix>
   hvor
     <prefix>   er de (maximalt) 4 el. 6 første tegn i katalogindgangens
                oprindelige navn.
     <dato-tid> er datoangivelse for omdøbelsestidspunktet,
                på en form der er afhængig af programnavnet:
                  datonavn   : år*1000 + måned*100 + dag (prefix max. 4 tegn)
                  ugenavn    : år*100 + ugenr            (prefix max. 6 tegn)
                  månedsnavn : år*100 + måned            (prefix max. 6 tegn)
     <postfix>  er et af tegnene <null>, a, b, ... , æ, ø, å
                i nævnte rækkefølge, til der findes et unikt navn.


programkald:
                      1  ( datonavn )                *
    ( <uddatamedie>= )   ( ugenavn  )  ( <sp><navn> )
                      0  (månedsnavn)                1


<navn> er navn på katalogindgang der skal omdøbes.

for hver omdøbt katalogindgang udskrives en linje på det
valgte uddatamedie:
    <gl.-navn> er omdøbt til <nyt-navn>

fejludskrifter:

  *** parameterfejl: <parameter>
    fejl i programparameter

  *** <navn> ukendt
    specificeret navn findes ikke i kataloget

  *** <navn> kan ikke omdøbes: <årsag>
    fejlstatus fra monitor(46) 'rename entry' eller
    unikt navn kav ikke dannes.

efter fejludskrift fortsættes normalt med næste parameter.

kaldte procedurer:
  openfp, closefp, skrivtegn, afsluttext, anbringtal, datodag

oversættelse:
  
  datonavn=algol connect.no datonavntx
  ugenavn=assig datonavn
  månedsnavn=assig datonavn

*>
\f

message datonavn, side 2 - 800117/cl;

  integer ppos, dato, tid, nr, postfix, type, res, pos, i,
    åå,mm,dd,uu,uå;
  real array ra(1:2);
  real t;
  long array field laf;
  integer array tail(1:10), nytnavn(1:4);
  boolean dagnavn,ugenavn,månedsnavn;
  zone list(128,1,stderror), z(1,1,stderror);

  if system(4,1,ra) = 6 shift 12 + 10 <* =<navn> *> then
    ppos:= 2
  else
    ppos:= 1;
 
  dagnavn:=ugenavn:=månedsnavn:=false;
  system(4,ppos-1,ra);
  if ra(1) shift (-16) shift 16 = real<:dato:>  then dagnavn:=true else
  if ra(1) shift (-24) shift 24 = real<:uge:>   then ugenavn:=true else
  if ra(1) shift (- 8) shift  8 = real<:måned:> then månedsnavn:=true else
                                                     dagnavn:=true;
  openfp(list,0);
  dato:= round(systime(5,0,t));
  tid:=  round(t);
  dd:= dato mod 100;
  mm:= (dato//100) mod 100;
  åå:= (dato//10000) mod 100 + 1900;
  datodag(åå,mm,dd,uu,0,uå,0);
  laf:= 0;
  nr:=dato;
  if dagnavn then nr:=dato else
  if ugenavn then nr:= (uå mod 100)*100 + uu else
  if månedsnavn then nr:= (åå mod 100)*100 + mm;
<*nr:= (dato mod 10000)*100 + (tid//10000) mod 100;*>

  for type:= system(4,ppos,ra) while type<>0 do
  begin
    if type <> 4 shift 12 + 10 then
    begin
      write(list,nl,1,<:*** parameterfejl: :>);
      if type extract 12 = 10 then
        write(list,ra.laf,nl,1)
      else
      if type extract 12 = 4 then
        write(list,<<d>,round(ra(1)),nl,1)
      else
        write(list,<:????<10>:>);
    end
    else
    begin
      open(z,0,ra,0);
      if monitor(42)lookup entry:(z,0,tail)<>0 then
        write(list,nl,1,<:*** :>,ra.laf,<: ukendt<10>:>)
      else
      begin
        if dagnavn then
          nytnavn.laf(1):= ra.laf(1) shift (-16) shift 16
        else
          nytnavn.laf(1):= ra.laf(1);

        pos:= 6;
        while nytnavn.laf(1) shift (8*(pos-6)) extract 8 = 0 do
          pos:= pos-1;
        pos:= pos+1;
        anbringtal(nytnavn,pos,nr,(if dagnavn then (-6) else (-4)));
        i:= pos; while i<13 do skrivtegn(nytnavn,i,0);
        postfix:= 96;
\f

message datonavn, side 3 - 800117/cl;

        repeat
          res:= monitor(46)rename entry:(z,0,nytnavn);
          if res=3 <*navn findes allerede *> then
          begin
            postfix:= postfix + 1;
            if postfix <= 125 then
            begin
              i:= pos;
              skrivtegn(nytnavn,i,postfix); afsluttext(nytnavn,i);
            end;
          end;
        until postfix>125 or res<>3;

        if res<>0 then
          write(list,<:<10>*** :>,ra.laf,<: kan ikke omdøbes: :>,
            case res of (<::>,<:catalog error:>,<:name conflict:>,
              <:base error:>,<:entry in use:>,<:name format:>,
              <:no maincat:>),nl,1)
        else
          write(list,nl,1,ra.laf,<: er omdøbt til :>,
            nytnavn.laf,nl,1);
      end;
      close(z,true);
    end;
    ppos:= ppos+1;
  end;

  closefp(list,true);
  trapmode:= 1 shift 10;
end
▶EOF◀