view release on metacpan or  search on metacpan

lib/CGI/Bus/upws.pm  view on Meta::CPAN

sub scrright {  # right screen (frameset)
 my $s =shift;
 my $d =$s->udata->param;
    $d =$s->udata->paramj if !$d->{'upws_frmurls'} || !scalar(@{$d->{'upws_frmurls'}});

 if ($d->{'upws_frmurls'}
 && $s->parent->ishtml($d->{'upws_frmurls'}->[0])) {
    $s->print->httpheader;
    $s->print(join("\n", @{$d->{'upws_frmurls'}}));
    return(1)
 }

 if (!$d->{upws_frmrows} && !$d->{upws_frmcols} 
 && $d->{upws_frmurls} && scalar(@{$d->{upws_frmurls}})) {
    my $r =scalar(@{$d->{upws_frmurls}});
    $d->{upws_frmrows} = (int(100/$r) .'%,') x $r;
    chop($d->{upws_frmrows})
 }

 $s->print->httpheader;
 $s->print("<frameset" 
          .($d->{upws_frmrows} ? (' rows="' .$d->{upws_frmrows} .'"') :'')
          .($d->{upws_frmcols} ? (' cols="' .$d->{upws_frmcols} .'"') :'')
          .">\n");
 if ($d->{upws_frmurls}) {
    foreach my $e (@{$d->{upws_frmurls}}) {
      $s->print("<frame src=\""
               .$e
               ."\">\n");
    }
 }
 $s->print("</frameset>\n");
 $s->print("</html>\n");

}





sub search {    # search screen
 my $s =shift;
 my $p =$s->parent;
 my $g =$p->cgi;
 $p->print->htpgstart(undef, {-class=>'PaneList'});
 $p->print->startform(-action=>$s->qurl, -class=>'PaneList');
 $p->print->hidden('_run'   =>'SEARCH');
 $s->print('<table width="100%" class="PaneList"><tr><td>');
 $s->print->h1($s->lng(0, 'Search'));
 $s->print('</td><td align="left" valign="bottom">')
          ->text($s->lng(1, 'Search', $s->parent->surl));
 $s->print('</td>');
 $s->print('</tr></table>');
 $s->print->htmltextfield(-name=>'query', -asize=>70, -class=>'PaneList')
          ->submit(-name =>'search', -class=>'PaneList'
                  ,-value=>$s->lng(0, 'Search')
                  ,-title=>$s->lng(1, 'Search'))
          ->br;
 $s->print->popup_menu(-name=>'querysort', -class=>'PaneList'
                      ,-values=>['write','hitcount','vpath','docauthor']
                      ,-labels=>{'write'    =>'Chronologically'
                                ,'hitcount' =>'Ranked'
                                ,'vpath'    =>'by Name'
                                ,'docauthor'=>'by Author'
                                }
                      ,-default=>'write');
 $s->print->popup_menu(-name=>'querymarg', -class=>'PaneList'
                      ,-values=>[128,256,512,1024,2048]
                      ,-labels=>{128 =>'128  max'
                                ,256 =>'256  max'
                                ,512 =>'512  max'
                                ,1024=>'1024 max'
                                ,2048=>'2048 max'
                                }
                      ,-default=>256);
# $s->print->a({-href=>
#      -e ($ENV{windir} .'/help/ix/htm/ixqrylan.htm')
#       ? '/help/microsoft/windows/ix/htm/ixqrylan.htm'
#       : '/help/microsoft/windows/isconcepts.chm' # .'::/ismain-concepts_30.htm'
#      }, '?')
#     if $s->{-searchms} && $^O eq 'MSWin32';

 $p->print->endform->text("\n");

 if (defined($s->qparam('query')) && $s->qparam('query') ne '') {
    if ($s->{-searchms} && $^O eq 'MSWin32' && ($ENV{SERVER_SOFTWARE}||'') =~/IIS/) {
       # Search MSDN for 'ixsso.Query'; See also:
       # Q248187 "HOWTO: Impersonate a User from Active Server Pages"
       # advapi32.dll: LogonUser, ImpersonateLoggedOnUser, ImpersonateSelf(int4(2)), RevertToSelf
       # 'Platform SDK: Security': 'Client/Server Access Control Functions'
       # "Replace a process level token" right
       if ($p->url !~/\/_*(login|auth|a|ntlm|search|guest)\//i
       && !$ENV{REMOTE_USER}) {
          $p->print->h1('Authentication required')
       } elsif ($p->{-cache}->{-RevertToSelf}) {
          $p->print->h1('Impersonation required')
       } else {
       eval('use Win32::OLE; Win32::OLE->Option("Warn"=>0)');
       my $oq =Win32::OLE->CreateObject("ixsso.Query");
       my $ou =Win32::OLE->CreateObject("ixsso.util");
       my $qs =[];
       my $qt =[];
       $oq->{Query}      =$s->qparam('query') =~/^(@\w|\{\s*prop\s+name\s+=)/i
                         ? $s->qparam('query')
                         : ('@contents ' .$s->qparam('query'));
       $oq->{Catalog}    ='Web';
       $oq->{MaxRecords} =$p->qparam('querymarg') ||256;
       $oq->{MaxRecords} =4096 if $oq->{MaxRecords} >4096;
       $oq->{SortBy}     =$p->qparam('querysort') ||'write';
       $oq->{SortBy}    .=$oq->{SortBy} =~/^(write|hitcount)$/i 
                         ? '[d],docauthor[a]' : '[a],write[d]';
       $oq->{Columns}    ='vpath,path,filename,hitcount,write,doctitle,docauthor,characterization';
       $oq->{LocaleID}   =1049 if $p->lngname =~/ru/i;
       push @$qs, $p->fpath
         if $p->fpath && ($p->fpath ne $p->ppath);
       push @$qs, $p->ppath
         if !(grep {$p->ppath eq $_} ($ENV{PATH_TRANSLATED}, '.'));
       push @$qs, $s->{-uspath}
         if $s->{-uspath} ||($s->{-usurl} && $s->_usdflt);
       foreach my $e (@$qs) {
         push @$qt, [$e =~/^(.+?)[\\\/][^\\\/]+$/ ? $1 : $e, ''] 
       }
       foreach my $e ('c:', 'd:') {
          push @$qt, [$e => ''] if !grep {lc($_->[0]) eq $e} @$qt
       }
       foreach my $e ($p->furl, $s->{-usurl}, $p->purl) {
         next if !$e;

lib/CGI/Bus/upws.pm  view on Meta::CPAN

 if ($un && $s->parent->uadmin($un)) {
     $s->parent->set('-cache')->{-user} =$un;
     $s->udata->load;
     $d =$s->udata->param;
 }

 $s->print->htpgstart(undef, $s->parent->hmerge($s->parent->{-htpnstart}, -class=>'PaneForm'));
 $s->print->startform(-action=>$s->qurl);

 $s->print->hidden('_run' =>'SETUP');
 $s->print->hidden('_run1'=>'SETUP');
 $s->print('<table width="100%" class="PaneForm"><tr><td>');
 $s->print->h1($s->lng(0, 'Setup') .' - ' .$s->parent->user);
 if (!$aa && !scalar(@$ua)) {
    $s->print($s->lng(1, 'Setup', $s->parent->user) .'</td>')
          ->td({-valign=>'top',-align=>'right',-class=>'PaneForm'}
              ,$g->submit(-name =>'save', -class=>'PaneForm'
                         ,-value=>$s->lng(0, 'Save')
                         ,-title=>$s->lng(1, 'Save')))
 }
 else {
    $s->print('</td><td align="left" valign="bottom" class="PaneForm">' 
	.$s->lng(1, 'Setup', $s->parent->user) .'</td>');
 }
 $s->print('</tr></table>');

 foreach my $p (qw(upws_urlh upws_frmrows upws_frmcols upws_usfhome urole)) {
    if    ($wr) {$d->{$p} =$g->param($p)}
    elsif ($rd) {$g->param($p, defined($d->{$p}) ? $d->{$p} : '')}
 }
 if    ($wr) {
    $d->{'upws_urls'}     =[split / *\r*\n\r* */, $g->param('upws_urls')];
    $d->{'upws_frmurls'}  =[split / *\r*\n\r* */, $g->param('upws_frmurls')];
    $d->{'uauth_managed'} =[split / *, */,        $g->param('uauth_managed')] 
                          if $aa;
    $d->{'uauth_groups'}  =[split / *, */,        $g->param('uauth_groups')]  
                          if $aa && $s->parent->uauth->set('-udata');
 }
 elsif ($rd) {
    foreach my $p (qw(upws_urls upws_frmurls uauth_managed uauth_groups)) {
      $g->param($p, '')
    }
    $g->param('upws_urls',     join("\n", @{$d->{'upws_urls'}}))     if $d->{'upws_urls'};
    $g->param('upws_frmurls',  join("\n", @{$d->{'upws_frmurls'}}))  if $d->{'upws_frmurls'};
    $g->param('uauth_managed', join(",",  @{$d->{'uauth_managed'}})) if $d->{'uauth_managed'} && $aa;
    $g->param('uauth_groups',  join(",",  @{$d->{'uauth_groups'}}))  if $d->{'uauth_groups'}  && $aa;
 }
 if    ($wr) {
    $s->udata->store;
    $s->pushmsg('Data Saved')
 }
 elsif ($rd) {
    $s->pushmsg('Data Loaded')
 }

 $s->print("<table class=\"PaneForm\">\n");
 $s->print('<tr>');
 if (scalar(@$ua)) {
 unshift @$ua, $u0;
 $s->print->th($ha, $s->lng(0, 'User'));
 $s->print->td($hd, $g->popup_menu(-name=>'user', -class=>'PaneForm'
                              ,-values=>$ua
                              ,-labels=>$s->uglist({},37)
                              ,-default=>($un||$u0)) 
                  . $g->submit(-name=>'read', -class=>'PaneForm'
                              ,-value=>$s->lng(0, 'Read')
                              ,-title=>$s->lng(1, 'Read'))
                  . $g->submit(-name=>'save', -class=>'PaneForm'
                              ,-value=>$s->lng(0, 'Save')
                              ,-title=>$s->lng(1, 'Save')));
 $s->print("</tr>\n<tr>");
 }
 if ($aa) {
 $s->print->th($ha, $s->lng(0, 'Managed'));
 $s->print->td($hd, $s->htmltextfield(-name=>'uauth_managed', -asize=>70, -class=>'PaneForm')
                  . $s->htmlddlb('',{-name=>'uauth_managed_', -class=>'PaneForm'}
				,sub{$_[0]->uglist({})}, ["\tuauth_managed"=>' '])
                  . $s->_ssfcmt('Managed')
              );
 $s->print("</tr>\n<tr>");
 if ($s->parent->uauth->set('-udata')) {
 $s->print->th($ha, $s->lng(0, 'Groups'));
 $s->print->td($hd, $s->htmltextfield(-name=>'uauth_groups', -asize=>70, -class=>'PaneForm')
                  . $s->htmlddlb('',{-name=>'uauth_groups_', -class=>'PaneForm'}
			,sub{$_[0]->uglist({})}, ["\tuauth_groups"=>' '])
                  . $s->_ssfcmt('Groups')
              );
 $s->print("</tr>\n<tr>");
 }
 }
 $s->print->th($ha, $s->lng(0, 'FavoriteURLs'));
 $s->print->td($hd, $s->htmltextarea(-name=>'upws_urls', -cols=>58, -arows=>4, -wrap=>'off', -class=>'PaneForm')
              .$s->_ssfcmt('FavoriteURLs'));
 $s->print("</tr>\n<tr>");
 $s->print->th($ha, $s->lng(0, 'HomeURL'));
 $s->print->td($hd, $s->htmltextfield(-name=>'upws_urlh', -asize=>70, -class=>'PaneForm')
              .$s->_ssfcmt('HomeURL'));
 $s->print("</tr>\n<tr>");
 $s->print->th($ha, $s->lng(0, 'FramesetURLs'));
 $s->print->td($hd, $s->htmltextarea(-name=>'upws_frmurls', -cols=>58, -arows=>4, -wrap=>'off', -class=>'PaneForm')
              .$s->_ssfcmt('FramesetURLs'));
 $s->print("</tr>\n<tr>");
 $s->print->th($ha, '..' .$s->lng(0, 'FramesetRows'));
 $s->print->td($ha, $s->htmltextfield(-name=>'upws_frmrows', -class=>'PaneForm')
              .$s->_ssfcmt('FramesetRows'));
#$s->print("</tr>\n<tr>"); # -asize=>70
 $s->print->th($ha, '..' .$s->lng(0, 'FramesetCols'));
 $s->print->td($ha, $s->htmltextfield(-name=>'upws_frmcols', -class=>'PaneForm')
              .$s->_ssfcmt('FramesetCols'));
 $s->print("</tr>\n<tr>");

 if ($s->{-uspurf}) {
 $s->print("</tr>\n<tr>");
 $s->print->th($ha, $s->lng(0, 'USFHome'));
 $s->param('upws_usfhome',$s->usfhome(1)) if $s->param('upws_usfhome_');
 $s->print->td($hd, $s->htmltextfield(-name=>'upws_usfhome', -asize=>70, -class=>'PaneForm')
              .$s->submit(-name=>'upws_usfhome_', -value=>'<-', -title=>$s->lng(1, 'Refresh'), -class=>'PaneForm')
              .$s->_ssfcmt('USFHome'));
 }

 $s->print("</tr>\n<tr>");
 $s->print->th($ha, $s->lng(0, 'PrimaryRole'));
 $s->print->td($hd, $s->popup_menu(-name=>'urole', -values=>['',@{$s->ugroups}], -class=>'PaneForm')
              .$s->_ssfcmt('PrimaryRole'));

 $s->print("</tr>\n<tr>");
 $s->print->th($ha, '');
 $s->print->td($hd, $g->submit(-name=>'save', -class=>'PaneForm'
                              ,-value=>$s->lng(0, 'Save')
                              ,-title=>$s->lng(1, 'Save')));
 $s->print("</tr>\n");
 $s->print("</table>\n");
 $s->scrbot;
 $s->print->htpfend;
}


sub _ssfcmt {
 '<span style="font-size: smaller;"><br />' .$_[0]->lng(1, $_[1]) .'</span>'
}


sub evaluate {  # execute workspace
 my $s =shift;
 my $c =$s->qparam('login')  ? 'LOGIN' 
       :$s->qparam('logout') ? 'LOGOUT'
       :$s->qparam('usites') ? 'USITES'
       :$s->qparam('search') ? 'SEARCH'
       :$s->qparam('query')  ? 'SEARCH'
       :($s->qrun ||'');
 $s->userauthopt() if $c ne 'LOGIN';
 if    ($c eq 'LEFT')   { $s->scrleft  }
 elsif ($c eq 'TOPR')   { $s->scrtopr  }
 elsif ($c eq 'RIGHT')  { $s->scrright }
 elsif ($c eq 'SETUP')  { $s->scrsetup }
 elsif ($c eq 'LOGIN')  { $s->parent->userauth($s->qurl)}
 elsif ($c eq 'LOGOUT') { $s->parent->uauth->logout($s->qurl)}
 elsif ($c eq 'USITES') { $s->scrusites}
 elsif ($c eq 'SEARCH') { $s->search   }
 else                   { $s->scrtop   }
}